data_lexer.mll 6.25 KB
Newer Older
1 2 3 4
(**************************************************************************)
(*                                                                        *)
(*                 ACG development toolkit                                *)
(*                                                                        *)
5
(*                  Copyright 2008-2018 INRIA                             *)
6
(*                                                                        *)
7
(*  More information on "http://acg.gforge.inria.fr/"                     *)
8 9 10 11 12 13 14 15 16 17 18 19
(*  License: CeCILL, see the LICENSE file or "http://www.cecill.info"     *)
(*  Authors: see the AUTHORS file                                         *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(*  $Rev::                              $:  Revision of last commit       *)
(*  $Author::                           $:  Author of last commit         *)
(*  $Date::                             $:  Date of last commit           *)
(*                                                                        *)
(**************************************************************************)

POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
20
{
21 22 23
  open UtilsLib
  open AcgData
  
24
  let pr lexbuf = Printf.printf "%s\n%!" (Lexing.lexeme lexbuf)
25 26

  let loc lexbuf = Lexing.lexeme_start_p lexbuf,Lexing.lexeme_end_p lexbuf
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
27 28 29 30 31

  let brackets = ref []

  let add_bracket loc = brackets:=loc::!brackets

POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
32
  let remove_bracket l = match !brackets with
33
    | [] -> raise (Error.Error (Error.Lexer_error (Error.Unstarted_bracket, l)))
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
34 35 36 37 38
    | _::tl -> brackets := tl

  let check_brackets () =
    match !brackets with
      | [] -> ()
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
39
      | (p1,p2)::__ -> let () = brackets := [] in 
40
	  raise (Error.Error (Error.Lexer_error (Error.Mismatch_parentheses,(p1,p2))))
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
                
  type context =
    | NoContext
    | Signature
    | Lexicon
    | LexiconComposition

  let ctx = ref NoContext
                
  let set c =  ctx:=c
                      
  let tok_in_context c t1 t2 =
      if !ctx = c then t1 else t2
                                 

56

POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
57 58
}

59
let newline = ('\010' | '\013' | "\013\010")
60
let letter = ['a'-'z' 'A'-'Z'  '' ''-'' ''-'' ''-'' ''-'']
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
61
let digit = ['0'-'9']
62
let string = (letter|digit|'_')*'\''*
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
63
  
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
64
let symbol = ['|' '!' '"' '#' '$' '%' '&' '\'' '*' '+' '-' '/' '<' '>' '?' '@' '[' '\\' ']' '^' '`' '{' '}' '~' ]
65
let keyword = ("end" | "type" | "prefix" | "infix" | "binder" | "lambda" | "Lambda")
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
66

POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
67
rule lexer =
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
68 69
    parse
      | [' ' '\t'] {lexer lexbuf}
70
      | newline {let () = Error.update_loc lexbuf None in lexer lexbuf}
71
      | "(*" {comment [loc lexbuf] lexbuf}
72
      | "*)" {raise (Error.Error (Error.Lexer_error (Error.Unstarted_comment,loc lexbuf)))}
73
      | eof {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
74
	     let () = check_brackets () in
75
	       Data_parser.EOI}
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
      | "signature" as id {
	    let () = check_brackets () in
            if !ctx = NoContext then
              let () = set Signature in
	      Data_parser.SIG_OPEN(loc lexbuf)
            else
              IDENT(id,loc lexbuf)}
      | "lexicon" as id {
	    let () = check_brackets () in
            if !ctx = NoContext then
              let () = set Lexicon in
	      Data_parser.LEX_OPEN(loc lexbuf)
            else
              IDENT(id,loc lexbuf)}
      | "nl_lexicon" as id {
	    let () = check_brackets () in
            if !ctx = NoContext then
              let () = set Lexicon in
	      Data_parser.NL_LEX_OPEN(loc lexbuf)
            else
              IDENT(id,loc lexbuf)}
97 98 99 100 101 102 103 104 105 106
(*      | "extend" as id {
	    let () = check_brackets () in
            if !ctx = NoContext then
            else
              IDENT(id,loc lexbuf)}
      | "with" as id {
	    let () = check_brackets () in
            if !ctx = NoContext then
            else
              IDENT(id,loc lexbuf)} *)
107
      | ['='] {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
108
	       let () = check_brackets () in
109
		 Data_parser.EQUAL(loc lexbuf)}
110
      | "<<" {
111 112 113
	    let () = check_brackets () in
            let () = set NoContext in
	    Data_parser.COMPOSE(loc lexbuf)}
114
      | [';'] {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
115
	       let () = check_brackets () in
116
		 Data_parser.SEMICOLON(loc lexbuf)}
117
      | [':'] {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
118
	       let () = check_brackets () in
119
		 Data_parser.COLON(loc lexbuf)}
120
      | [','] {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
121
	       let () = check_brackets () in
122
		 Data_parser.COMMA(loc lexbuf)}
123
      | ['('] {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
124
	       let l = loc lexbuf in
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
125
	       let () = add_bracket l in
126
		 Data_parser.LPAREN l}
127
      | [')'] {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
128
	       let brac_loc = loc lexbuf in
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
129
	       let () = remove_bracket brac_loc in
130
		 Data_parser.RPAREN brac_loc}
131
      | ['.'] {
132
		 Data_parser.DOT(loc lexbuf)}
133
      | "end" {
134 135
	    let () = check_brackets () in
            let () = set NoContext in
136
		 Data_parser.END_OF_DEC(loc lexbuf)}
137 138 139
      | '\\' keyword as id {
	       let () = check_brackets () in
		 Data_parser.IDENT(id,loc lexbuf)}
140
      | "type" {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
141
		let () = check_brackets () in
142
		  Data_parser.TYPE(loc lexbuf)}
143
      | "prefix" {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
144
		  let () = check_brackets () in
145
		    Data_parser.PREFIX(loc lexbuf)}
146
      | "infix" {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
147
		 let () = check_brackets () in
148
		   Data_parser.INFIX(loc lexbuf)}
149
      | "binder" {
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
150
		  let () = check_brackets () in
151
		    Data_parser.BINDER(loc lexbuf)}
152
      | "lambda" {
153
		    Data_parser.LAMBDA0(loc lexbuf)}
154
      | "Lambda" {
155
		    Data_parser.LAMBDA(loc lexbuf)}
156
      | "->" {
157
		Data_parser.LIN_ARROW(loc lexbuf)}
158
      | "=>" {
159
		Data_parser.ARROW(loc lexbuf)}
160
      | ":=" {
161
		Data_parser.COLON_EQUAL(loc lexbuf)}
162
      | letter string as id { Data_parser.IDENT (id,loc lexbuf) }
163
      | symbol {
164
		  Data_parser.SYMBOL (Lexing.lexeme lexbuf,loc lexbuf)}
165
      | _ as input_char {let () = Printf.fprintf stderr "%c" input_char in raise (Error.Error (Error.Lexer_error (Error.Bad_token,loc lexbuf)))}
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
166
    and comment depth = parse
167 168 169
      | "*)" {match depth with
		| [a] -> lexer lexbuf
		| a::tl -> comment tl lexbuf
170
		| [] -> raise (Error.Error (Error.Lexer_error (Error.Unstarted_comment,loc lexbuf)))}
171
      | "(*" {comment ((loc lexbuf)::depth) lexbuf}
172
      | eof {raise (Error.Error (Error.Lexer_error (Error.Unclosed_comment, List.hd depth)))}
173
      | newline {let () = Error.update_loc lexbuf None in comment depth lexbuf}
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
174
      | _ {comment depth lexbuf}
POGODALLA Sylvain's avatar
POGODALLA Sylvain committed
175

176

177