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

Diff of /parser/parser.ml

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

revision 373 by abate, Tue Jul 10 17:26:28 2007 UTC revision 374 by abate, Tue Jul 10 17:29:46 2007 UTC
# Line 9  Line 9 
9  let gram    = Grammar.gcreate (Wlexer.lexer Wlexer.token Wlexer.latin1_engine)  let gram    = Grammar.gcreate (Wlexer.lexer Wlexer.token Wlexer.latin1_engine)
10    
11    
12    let parse_ident = Encodings.Utf8.mk_latin1
13    
14    let label s = LabelPool.mk (parse_ident s)
15    
16  let prog    = Grammar.Entry.create gram "prog"  let prog    = Grammar.Entry.create gram "prog"
17  let expr    = Grammar.Entry.create gram "expression"  let expr    = Grammar.Entry.create gram "expression"
18  let pat     = Grammar.Entry.create gram "type/pattern expression"  let pat     = Grammar.Entry.create gram "type/pattern expression"
# Line 141  Line 145 
145      "top" RIGHTA      "top" RIGHTA
146      [ "match"; e = SELF; "with"; b = branches -> exp loc (Match (e,b))      [ "match"; e = SELF; "with"; b = branches -> exp loc (Match (e,b))
147      | "try"; e = SELF; "with"; b = branches ->      | "try"; e = SELF; "with"; b = branches ->
148            let id = ident (U.mk "x") in
149          let default =          let default =
150            mknoloc (Capture (ident "x")),            mknoloc (Capture id),
151            Op ("raise",[Var (ident "x")]) in            Op ("raise",[Var id]) in
152          exp loc (Try (e,b@[default]))          exp loc (Try (e,b@[default]))
153      | "map"; e = SELF; "with"; b = branches -> exp loc (Map (e,b))      | "map"; e = SELF; "with"; b = branches -> exp loc (Map (false,e,b))
154      | "xtransform"; e = SELF; "with"; b = branches -> exp loc (Xtrans (e,b))      | "xtransform"; e = SELF; "with"; b = branches -> exp loc (Xtrans (e,b))
155      | "if"; e = SELF; "then"; e1 = SELF; "else"; e2 = SELF ->      | "if"; e = SELF; "then"; e1 = SELF; "else"; e2 = SELF ->
156          let p1 = mk loc (Internal (Builtin.true_type))          let p1 = mk loc (Internal (Builtin.true_type))
157          and p2 = mk loc (Internal (Builtin.false_type)) in          and p2 = mk loc (Internal (Builtin.false_type)) in
158          exp loc (Match (e, [p1,e1; p2,e2]))          exp loc (Match (e, [p1,e1; p2,e2]))
159      | "transform"; e = SELF; "with"; b = branches ->      | "transform"; e = SELF; "with"; b = branches ->
160          let default = mknoloc (Capture (ident "x")), cst_nil in          exp loc (Op ("flatten", [Map (true,e,b)]))
         exp loc (Op ("flatten", [Map (e,b@[default])]))  
161      | "fun"; (f,a,b) = fun_decl ->      | "fun"; (f,a,b) = fun_decl ->
162          exp loc (Abstraction { fun_name = f; fun_iface = a; fun_body = b })          exp loc (Abstraction { fun_name = f; fun_iface = a; fun_body = b })
163      | (p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->      | (p,e1) = let_binding; "in"; e2 = expr LEVEL "top"->
# Line 176  Line 180 
180      [ e1 = expr; op = ["+" | "-" | "@" ]; e2 = expr ->      [ e1 = expr; op = ["+" | "-" | "@" ]; e2 = expr ->
181          exp loc (Op (op,[e1;e2]))          exp loc (Op (op,[e1;e2]))
182      | e = expr; "\\"; l = [LIDENT | UIDENT | keyword ] ->      | e = expr; "\\"; l = [LIDENT | UIDENT | keyword ] ->
183          exp loc (RemoveField (e,LabelPool.mk l))          exp loc (RemoveField (e, label l))
184      ]      ]
185      |      |
186      [ e1 = expr; op = ["*"]; e2 = expr -> exp loc (Op (op,[e1;e2]))      [ e1 = expr; op = ["*"]; e2 = expr -> exp loc (Op (op,[e1;e2]))
# Line 185  Line 189 
189          let tag = mk loc (Internal (Types.atom (Atoms.any))) in          let tag = mk loc (Internal (Types.atom (Atoms.any))) in
190          let att = mk loc (Internal Types.Record.any) in          let att = mk loc (Internal Types.Record.any) in
191          let any = mk loc (Internal (Types.any)) in          let any = mk loc (Internal (Types.any)) in
192          let re = Star(Alt(SeqCapture(ident "x",Elem p), Elem any)) in          let id = ident (U.mk "x") in
193            let re = Star(Alt(SeqCapture(id,Elem p), Elem any)) in
194          let ct = mk loc (Regexp (re,any)) in          let ct = mk loc (Regexp (re,any)) in
195          let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in          let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in
196          let b = (p,  Var (ident "x")) in          let b = (p,  Var id) in
197          exp loc (Op ("flatten", [Map (e,[b])]))          exp loc (Op ("flatten", [Map (false,e,[b])]))
198      ]      ]
199      |      |
200      [ e = expr;  "."; l = [LIDENT | UIDENT | keyword ] ->      [ e = expr;  "."; l = [LIDENT | UIDENT | keyword ] ->
201          exp loc (Dot (e,LabelPool.mk l))          exp loc (Dot (e, label l))
202      ]      ]
203    
204      |      |
205      [ op = [ LIDENT "flatten"      [ op = [ LIDENT "flatten"
206             | LIDENT "load_xml"             | LIDENT "load_xml"
207             | LIDENT "load_file"             | LIDENT "load_file" | LIDENT "load_file_utf8"
208             | LIDENT "load_html"             | LIDENT "load_html"
209             | LIDENT "print_xml"             | LIDENT "print_xml" | LIDENT "print_xml_utf8"
210             | LIDENT "print"             | LIDENT "print"
211             | LIDENT "raise"             | LIDENT "raise"
212             | LIDENT "int_of"             | LIDENT "int_of"
# Line 209  Line 214 
214             | LIDENT "atom_of"             | LIDENT "atom_of"
215             ];             ];
216        e = expr -> exp loc (Op (op,[e]))        e = expr -> exp loc (Op (op,[e]))
217      | op = [ LIDENT "dump_to_file" ];      | op = [ LIDENT "dump_to_file" | LIDENT "dump_to_file_utf8" ];
218        e1 = expr LEVEL "no_appl"; e2 = expr -> exp loc (Op (op, [e1;e2]))        e1 = expr LEVEL "no_appl"; e2 = expr -> exp loc (Op (op, [e1;e2]))
219      | e1 = SELF; LIDENT "div"; e2 = expr -> exp loc (Op ("/", [e1;e2]))      | e1 = SELF; LIDENT "div"; e2 = expr -> exp loc (Op ("/", [e1;e2]))
220      | e1 = SELF; LIDENT "mod"; e2 = expr -> exp loc (Op ("mod", [e1;e2]))      | e1 = SELF; LIDENT "mod"; e2 = expr -> exp loc (Op ("mod", [e1;e2]))
# Line 231  Line 236 
236          exp loc l          exp loc l
237      | "<"; t = [ "("; e = expr; ")" -> e      | "<"; t = [ "("; e = expr; ")" -> e
238                 | a = [ LIDENT | UIDENT | keyword ] ->                 | a = [ LIDENT | UIDENT | keyword ] ->
239                       let a = parse_ident a in
240                       exp loc (Cst (Types.Atom (Atoms.mk a))) ];                       exp loc (Cst (Types.Atom (Atoms.mk a))) ];
241          a = expr_attrib_spec; ">"; c = expr ->          a = expr_attrib_spec; ">"; c = expr ->
242          exp loc (Xml (t, Pair (a,c)))          exp loc (Xml (t, Pair (a,c)))
243      | "{"; r = [ expr_record_spec | -> exp loc (RecordLitt LabelMap.empty) ]; "}" -> r      | "{"; r = [ expr_record_spec | -> exp loc (RecordLitt LabelMap.empty) ]; "}" -> r
244      | s = STRING2 ->      | s = STRING2 ->
245          exp loc (tuple (char_list loc s @ [cst_nil]))          exp loc (tuple (char_list loc s @ [cst_nil]))
246      | a = LIDENT -> exp loc (Var (ident a))      | a = LIDENT -> exp loc (Var (ident (parse_ident a)))
247      ]      ]
248    
249    ];    ];
# Line 266  Line 272 
272   fun_decl: [   fun_decl: [
273  (* need an hack to do this, because both productions would  (* need an hack to do this, because both productions would
274     match   [ OPT LIDENT; "("; pat ] .... *)     match   [ OPT LIDENT; "("; pat ] .... *)
275     [ f = OPT [ x = LIDENT -> ident x]; "("; p1 = pat LEVEL "no_arrow";     [ f = OPT [ x = LIDENT -> ident (parse_ident x)]; "("; p1 = pat LEVEL "no_arrow";
276      res = [ "->"; p2 = pat;      res = [ "->"; p2 = pat;
277              a = [ ";"; a = LIST0 arrow SEP ";" -> a | -> [] ];              a = [ ";"; a = LIST0 arrow SEP ";" -> a | -> [] ];
278              ")"; b = branches -> `Classic (p2,a,b)              ")"; b = branches -> `Classic (p2,a,b)
# Line 308  Line 314 
314            | _ -> Alt (x,y)            | _ -> Alt (x,y)
315      ]      ]
316    | [ x = regexp; y = regexp -> Seq (x,y) ]    | [ x = regexp; y = regexp -> Seq (x,y) ]
317    | [ a = LIDENT; "::"; x = regexp -> SeqCapture (ident a,x) ]    | [ a = LIDENT; "::"; x = regexp -> SeqCapture (ident (parse_ident a),x) ]
318    | [ x = regexp; "*" -> Star x    | [ x = regexp; "*" -> Star x
319      | x = regexp; "*?" -> WeakStar x      | x = regexp; "*?" -> WeakStar x
320      | x = regexp; "+" -> Seq (x, Star x)      | x = regexp; "+" -> Seq (x, Star x)
# Line 317  Line 323 
323      | x = regexp; "??" -> Alt (Epsilon, x) ]      | x = regexp; "??" -> Alt (Epsilon, x) ]
324    | [ "("; x = regexp; ")" -> x    | [ "("; x = regexp; ")" -> x
325      | "("; a = LIDENT; ":="; c = const; ")" ->      | "("; a = LIDENT; ":="; c = const; ")" ->
326          Elem (mk loc (Constant ((ident a,c))))          Elem (mk loc (Constant ((ident (parse_ident a),c))))
327      | UIDENT "PCDATA" -> string_regexp      | UIDENT "PCDATA" -> string_regexp
328      | i = STRING1; "--"; j = STRING1 ->      | i = STRING1; "--"; j = STRING1 ->
329          let i = Chars.mk_int (parse_char loc i)          let i = Chars.mk_int (parse_char loc i)
# Line 350  Line 356 
356        [ "{"; r = record_spec; "}" -> mk loc (Record (true,r))        [ "{"; r = record_spec; "}" -> mk loc (Record (true,r))
357        | "{|"; r = record_spec; "|}" -> mk loc (Record (false,r))        | "{|"; r = record_spec; "|}" -> mk loc (Record (false,r))
358        | LIDENT "_" -> mk loc (Internal Types.any)        | LIDENT "_" -> mk loc (Internal Types.any)
359        | a = LIDENT -> mk loc (Capture (ident a))        | a = LIDENT -> mk loc (Capture (ident (parse_ident a)))
360        | "("; a = LIDENT; ":="; c = const; ")" ->        | "("; a = LIDENT; ":="; c = const; ")" ->
361            mk loc (Constant (ident a,c))            mk loc (Constant (ident (parse_ident a),c))
362        | a = UIDENT -> mk loc (PatVar a)        | a = UIDENT -> mk loc (PatVar a)
363        | i = INT ; "--"; j = INT ->        | i = INT ; "--"; j = INT ->
364            let i =  Intervals.mk i            let i =  Intervals.mk i
# Line 379  Line 385 
385               "]" -> mk loc (Regexp (r,q))               "]" -> mk loc (Regexp (r,q))
386        | "<"; t =        | "<"; t =
387          [ x = [ LIDENT | UIDENT | keyword ] ->          [ x = [ LIDENT | UIDENT | keyword ] ->
388              let a = if x = "_" then Atoms.any else Atoms.atom (Atoms.mk x) in              let a = if x = "_" then Atoms.any else Atoms.atom (Atoms.mk (parse_ident x)) in
389              mk loc (Internal (Types.atom a))              mk loc (Internal (Types.atom a))
390          | "("; t = pat; ")" -> t ];          | "("; t = pat; ")" -> t ];
391          a = attrib_spec; ">"; c = pat ->          a = attrib_spec; ">"; c = pat ->
# Line 403  Line 409 
409                    o = [ "?" -> true | -> false];                    o = [ "?" -> true | -> false];
410                    x = pat ->                    x = pat ->
411                      let x = if o then mk loc (Optional x) else x in                      let x = if o then mk loc (Optional x) else x in
412                      (LabelPool.mk l, x)                      (label l, x)
413                  ] SEP ";" ->                  ] SEP ";" ->
414            make_record loc r            make_record loc r
415        ] ];        ] ];
# Line 417  Line 423 
423    const:    const:
424      [      [
425        [ i = INT -> Types.Integer (Intervals.mk i)        [ i = INT -> Types.Integer (Intervals.mk i)
426        | "`"; a = [LIDENT | UIDENT | keyword ] -> Types.Atom (Atoms.mk a)        | "`"; a = [LIDENT | UIDENT | keyword ] -> Types.Atom (Atoms.mk (parse_ident a))
427        | c = char -> Types.Char c ]        | c = char -> Types.Char c ]
428      ];      ];
429    
# Line 432  Line 438 
438    expr_record_spec:    expr_record_spec:
439      [ [ r = LIST1      [ [ r = LIST1
440                [ l = [LIDENT | UIDENT | keyword ]; "="; x = expr ->                [ l = [LIDENT | UIDENT | keyword ]; "="; x = expr ->
441                    (LabelPool.mk l,x) ]                    (label l,x) ]
442                SEP ";" ->                SEP ";" ->
443            exp loc (RecordLitt (make_record loc r))            exp loc (RecordLitt (make_record loc r))
444        ] ];        ] ];
Legend:
Removed from v.373  
changed lines
  Added in v.374
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5