/[svn]/parser/parser.ml
ViewVC logotype

Diff of /parser/parser.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 80 by abate, Tue Jul 10 17:04:23 2007 UTC revision 81 by abate, Tue Jul 10 17:04:39 2007 UTC
# Line 2  Line 2 
2  open Ast  open Ast
3    
4  (* let ()  = Grammar.error_verbose := true *)  (* let ()  = Grammar.error_verbose := true *)
5    
6  let gram    = Grammar.gcreate (Lexer.gmake ())  let gram    = Grammar.gcreate (Lexer.gmake ())
7    
8    let gram    = Grammar.gcreate (Wlexer.lexer Wlexer.token Wlexer.latin1_engine)
9    
10    
11  let prog    = Grammar.Entry.create gram "prog"  let prog    = Grammar.Entry.create gram "prog"
12  let expr    = Grammar.Entry.create gram "expression"  let expr    = Grammar.Entry.create gram "expression"
13  let pat     = Grammar.Entry.create gram "type/pattern expression"  let pat     = Grammar.Entry.create gram "type/pattern expression"
# Line 32  Line 37 
37      else aux (((pos+i,pos+i+1),s.[i-1])::accu) (i-1) in      else aux (((pos+i,pos+i+1),s.[i-1])::accu) (i-1) in
38    aux [] (String.length s)    aux [] (String.length s)
39    
40    exception Error of string
41    let error loc s = raise (Location (loc, Error s))
42    
43    let parse_char loc s =
44      (* TODO: Unicode *)
45      if String.length s <> 1 then
46        error loc "Character litteral must have length 1";
47      s.[0]
48    
49  let char_list pos s =  let char_list pos s =
50    let s = seq_of_string pos (Token.eval_string s) in    let s = seq_of_string pos s in
51    List.map (fun (loc,c) -> mk loc (Cst (Types.Char (Chars.Unichar.from_char c)))) s    List.map (fun (loc,c) -> mk loc (Cst (Types.Char (Chars.Unichar.from_char c)))) s
52    
53    
# Line 49  Line 62 
62      [ (p,e) = let_binding -> LetDecl (p,e)      [ (p,e) = let_binding -> LetDecl (p,e)
63      | (p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->      | (p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
64          EvalStatement (mk loc (Match (e1,[p,e2])))          EvalStatement (mk loc (Match (e1,[p,e2])))
65      | "type"; x = UIDENT; "="; t = pat -> TypeDecl (x,t)      | LIDENT "type"; x = UIDENT; "="; t = pat -> TypeDecl (x,t)
66      | "debug"; d = debug_directive -> Debug d      | LIDENT "debug"; d = debug_directive -> Debug d
67      ] |      ] |
68      [ e = expr -> EvalStatement e      [ e = expr -> EvalStatement e
69      ]      ]
# Line 72  Line 85 
85            (mk noloc (Capture "x"),            (mk noloc (Capture "x"),
86             mk noloc (Op ("raise",[mk noloc (Var "x")]))) in             mk noloc (Op ("raise",[mk noloc (Var "x")]))) in
87          mk loc (Try (e,b@[default]))          mk loc (Try (e,b@[default]))
88      | LIDENT "map"; e = SELF; "with"; b = branches -> mk loc (Map (e,b))      | "map"; e = SELF; "with"; b = branches -> mk loc (Map (e,b))
89      | "transform"; e = SELF; "with"; b = branches ->      | "transform"; e = SELF; "with"; b = branches ->
90          mk noloc (Op ("flatten", [mk loc (Map (e,b))]))          mk noloc (Op ("flatten", [mk loc (Map (e,b))]))
91      | "fun"; (f,a,b) = fun_decl ->      | "fun"; (f,a,b) = fun_decl ->
# Line 113  Line 126 
126          let e = match e with Some e -> e | None -> cst_nil in          let e = match e with Some e -> e | None -> cst_nil in
127          let l = List.flatten l in          let l = List.flatten l in
128          tuple loc (l @ [e])          tuple loc (l @ [e])
129      | "<"; t = expr_tag_spec; a = expr_attrib_spec; ">"; c = expr ->      | t = [ a = TAG ->
130                  mk loc (Cst (Types.Atom (Types.AtomPool.mk a)))
131              | "<"; e = expr LEVEL "no_appl" -> e ];
132            a = expr_attrib_spec; ">"; c = expr ->
133          tuple loc [t;a;c]          tuple loc [t;a;c]
134      | "{"; r = [ expr_record_spec | -> mk loc (RecordLitt []) ]; "}" -> r      | "{"; r = [ expr_record_spec | -> mk loc (RecordLitt []) ]; "}" -> r
135      | s = STRING ->      | s = STRING2 ->
136          tuple loc (char_list loc s @ [cst_nil])          tuple loc (char_list loc s @ [cst_nil])
137      | "!"; t = pat -> mk loc (DebugTyper t)      | "!"; t = pat -> mk loc (DebugTyper t)
138      | a = LIDENT -> mk loc (Var a)      | a = LIDENT -> mk loc (Var a)
# Line 125  Line 141 
141    ];    ];
142    
143    seq_elem: [    seq_elem: [
144      [ x = CHAR -> char_list loc x      [ x = STRING1 -> char_list loc x
145      | e = expr LEVEL "no_appl" -> [e]      | e = expr LEVEL "no_appl" -> [e]
146      ]      ]
147    ];    ];
# Line 160  Line 176 
176    ];    ];
177    
178    branches: [    branches: [
179      [ OPT "|"; l = LIST1 branch SEP "|" ; OPT "end" -> l ]      [ OPT "|"; l = LIST1 branch SEP "|" -> l ]
180    ];    ];
181    
182    branch: [    branch: [
# Line 180  Line 196 
196      | x = regexp; "??" -> Alt (Epsilon, x) ]      | x = regexp; "??" -> Alt (Epsilon, x) ]
197    | [ "("; x = regexp; ")" -> x    | [ "("; x = regexp; ")" -> x
198      | UIDENT "PCDATA" -> string_regexp      | UIDENT "PCDATA" -> string_regexp
199      | i = CHAR ; "--"; j = CHAR ->      | i = STRING1; "--"; j = STRING1 ->
200          let i = Chars.Unichar.from_char (Token.eval_char i)          let i = Chars.Unichar.from_char (parse_char loc i)
201          and j = Chars.Unichar.from_char (Token.eval_char j) in          and j = Chars.Unichar.from_char (parse_char loc j) in
202          Elem (mk loc (Internal (Types.char (Chars.char_class i j))))          Elem (mk loc (Internal (Types.char (Chars.char_class i j))))
203      |  s = CHAR ->      |  s = STRING1 ->
204          let s = seq_of_string loc (Token.eval_string s) in          let s = seq_of_string loc s in
205          List.fold_right          List.fold_right
206            (fun (loc,c) accu ->            (fun (loc,c) accu ->
207               let c = Chars.Unichar.from_char c in               let c = Chars.Unichar.from_char c in
# Line 219  Line 235 
235        | i = INT ->        | i = INT ->
236            let i = Big_int.big_int_of_string i  in            let i = Big_int.big_int_of_string i  in
237            mk loc (Internal (Types.interval (Intervals.atom i)))            mk loc (Internal (Types.interval (Intervals.atom i)))
238        | "*--"; j = INT ->        | "*"; "--"; j = INT ->
239            let j = Big_int.big_int_of_string j in            let j = Big_int.big_int_of_string j in
240            mk loc (Internal (Types.interval (Intervals.left j)))            mk loc (Internal (Types.interval (Intervals.left j)))
241        | i = INT; "--*" ->        | i = INT; "--"; "*" ->
242            let i = Big_int.big_int_of_string i in            let i = Big_int.big_int_of_string i in
243            mk loc (Internal (Types.interval (Intervals.right i)))            mk loc (Internal (Types.interval (Intervals.right i)))
244        | i = char ->        | i = char ->
# Line 235  Line 251 
251               q = [ ";"; q = pat -> q               q = [ ";"; q = pat -> q
252                   | -> mk noloc (Internal (Sequence.nil_type)) ];                   | -> mk noloc (Internal (Sequence.nil_type)) ];
253               "]" -> mk loc (Regexp (r,q))               "]" -> mk loc (Regexp (r,q))
254        | "<"; t = tag_spec; a = attrib_spec; ">"; c = pat ->        | t = [
255              [ "<"; LIDENT "_" -> mk loc (Internal (Types.atom (Atoms.any)))
256              | a = TAG ->
257                  mk loc
258                  (Internal (Types.atom (Atoms.atom (Types.AtomPool.mk a)))) ]
259            | [ "<"; t = pat -> t ]
260            ];
261            a = attrib_spec; ">"; c = pat ->
262            multi_prod loc [t;a;c]            multi_prod loc [t;a;c]
263        | s = STRING ->        | s = STRING2 ->
264            let s = seq_of_string loc (Token.eval_string s) in            let s = seq_of_string loc s in
265            let s = List.map            let s = List.map
266                      (fun (loc,c) ->                      (fun (loc,c) ->
267                         mk loc (Internal                         mk loc (Internal
# Line 252  Line 275 
275    ];    ];
276    
277    record_spec:    record_spec:
278      [ [ r = LIST0 [ l = [LIDENT | UIDENT];      [ [ r = LIST0 [ l = [LIDENT | UIDENT]; "=";
279                    o = ["=?" -> true | "=" -> false];                    o = [ "?" -> true | -> false];
280                    x = pat ->                    x = pat ->
281                      mk loc (Record (Types.LabelPool.mk l,o,x))                      mk loc (Record (Types.LabelPool.mk l,o,x))
282                  ] SEP ";" ->                  ] SEP ";" ->
# Line 264  Line 287 
287    
288    char:    char:
289      [      [
290        [ c = CHAR -> Chars.Unichar.from_char (Token.eval_char c)        [ c = STRING1 -> Chars.Unichar.from_char (parse_char loc c)
291        | "!"; i = INT -> Chars.Unichar.from_int (int_of_string i) ]        | "!"; i = INT -> Chars.Unichar.from_int (int_of_string i) ]
292      ];      ];
293    
# Line 276  Line 299 
299        | c = char -> Types.Char c ]        | c = char -> Types.Char c ]
300      ];      ];
301    
   tag_spec:  
     [  
       [ LIDENT "_" -> mk loc (Internal (Types.atom (Atoms.any))) ]  
     | [ a = [LIDENT | UIDENT] ->  
           mk loc (Internal (Types.atom (Atoms.atom (Types.AtomPool.mk a)))) ]  
     | [ t = pat -> t ]  
     ];  
302    
303    attrib_spec:    attrib_spec:
304      [ [ r = record_spec -> r | "("; t = pat; ")" -> t ] ];      [ [ r = record_spec -> r | "("; t = pat; ")" -> t ] ];
# Line 295  Line 311 
311            mk loc (RecordLitt r)            mk loc (RecordLitt r)
312        ] ];        ] ];
313    
   expr_tag_spec:  
     [  
       [ a = [LIDENT | UIDENT] ->  
           mk loc (Cst (Types.Atom (Types.AtomPool.mk a))) ]  
     | [ e = expr LEVEL "no_appl" -> e ]  
     ];  
   
314    expr_attrib_spec:    expr_attrib_spec:
315      [ [ r = expr_record_spec -> r ]      [ [ r = expr_record_spec -> r ]
316      | [ e = expr LEVEL "no_appl" -> e      | [ e = expr LEVEL "no_appl" -> e
# Line 316  Line 325 
325  END  END
326    
327  let pat = Grammar.Entry.parse pat  let pat = Grammar.Entry.parse pat
328  let expr = Grammar.Entry.parse expr  and expr = Grammar.Entry.parse expr
329  let prog = Grammar.Entry.parse prog  and prog = Grammar.Entry.parse prog
330    
331  module From_string = struct  module From_string = struct
332    let pat s = Grammar.Entry.parse pat' (Stream.of_string s)    let pat s = Grammar.Entry.parse pat' (Stream.of_string s)
Legend:
Removed from v.80  
changed lines
  Added in v.81
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5