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

Diff of /parser/parser.ml

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

revision 374 by abate, Tue Jul 10 17:29:46 2007 UTC revision 375 by abate, Tue Jul 10 17:29:53 2007 UTC
# Line 11  Line 11 
11    
12  let parse_ident = Encodings.Utf8.mk_latin1  let parse_ident = Encodings.Utf8.mk_latin1
13    
14    let id_dummy = ident (U.mk "$$$")
15    let atom s = Atoms.mk (parse_ident s)
16  let label s = LabelPool.mk (parse_ident s)  let label s = LabelPool.mk (parse_ident s)
17    let ident s = ident (parse_ident s)
18    
19  let prog    = Grammar.Entry.create gram "prog"  let prog    = Grammar.Entry.create gram "prog"
20  let expr    = Grammar.Entry.create gram "expression"  let expr    = Grammar.Entry.create gram "expression"
# Line 124  Line 127 
127      [ LIDENT "filter"; t = pat; p = pat -> `Filter(t,p)      [ LIDENT "filter"; t = pat; p = pat -> `Filter(t,p)
128      | LIDENT "accept"; p = pat -> `Accept p      | LIDENT "accept"; p = pat -> `Accept p
129      | LIDENT "compile"; t = pat; p = LIST1 pat -> `Compile (t,p)      | LIDENT "compile"; t = pat; p = LIST1 pat -> `Compile (t,p)
     | LIDENT "normal_record"; t = pat -> `Normal_record t  
     | LIDENT "compile2"; t = pat; p = LIST1 pat -> `Compile2 (t,p)  
130      | LIDENT "subtype"; t1 = pat; t2 = pat -> `Subtype (t1,t2)      | LIDENT "subtype"; t1 = pat; t2 = pat -> `Subtype (t1,t2)
131      ]      ]
132    ];    ];
# Line 145  Line 146 
146      "top" RIGHTA      "top" RIGHTA
147      [ "match"; e = SELF; "with"; b = branches -> exp loc (Match (e,b))      [ "match"; e = SELF; "with"; b = branches -> exp loc (Match (e,b))
148      | "try"; e = SELF; "with"; b = branches ->      | "try"; e = SELF; "with"; b = branches ->
         let id = ident (U.mk "x") in  
149          let default =          let default =
150            mknoloc (Capture id),            mknoloc (Capture id_dummy),
151            Op ("raise",[Var id]) in            Op ("raise",[Var id_dummy]) in
152          exp loc (Try (e,b@[default]))          exp loc (Try (e,b@[default]))
153      | "map"; e = SELF; "with"; b = branches -> exp loc (Map (false,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))
# Line 189  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 id = ident (U.mk "x") in          let re = Star(Alt(SeqCapture(id_dummy,Elem p), Elem any)) in
         let re = Star(Alt(SeqCapture(id,Elem p), Elem any)) in  
193          let ct = mk loc (Regexp (re,any)) in          let ct = mk loc (Regexp (re,any)) in
194          let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in          let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in
195          let b = (p,  Var id) in          let b = (p,  Var id_dummy) in
196          exp loc (Op ("flatten", [Map (false,e,[b])]))          exp loc (Op ("flatten", [Map (false,e,[b])]))
197      ]      ]
198      |      |
# Line 236  Line 235 
235          exp loc l          exp loc l
236      | "<"; t = [ "("; e = expr; ")" -> e      | "<"; t = [ "("; e = expr; ")" -> e
237                 | a = [ LIDENT | UIDENT | keyword ] ->                 | a = [ LIDENT | UIDENT | keyword ] ->
238                     let a = parse_ident a in                     exp loc (Cst (Types.Atom (atom a))) ];
                    exp loc (Cst (Types.Atom (Atoms.mk a))) ];  
239          a = expr_attrib_spec; ">"; c = expr ->          a = expr_attrib_spec; ">"; c = expr ->
240          exp loc (Xml (t, Pair (a,c)))          exp loc (Xml (t, Pair (a,c)))
241      | "{"; r = [ expr_record_spec | -> exp loc (RecordLitt LabelMap.empty) ]; "}" -> r      | "{"; r = [ expr_record_spec | -> exp loc (RecordLitt LabelMap.empty) ]; "}" -> r
242      | s = STRING2 ->      | s = STRING2 ->
243          exp loc (tuple (char_list loc s @ [cst_nil]))          exp loc (tuple (char_list loc s @ [cst_nil]))
244      | a = LIDENT -> exp loc (Var (ident (parse_ident a)))      | a = LIDENT -> exp loc (Var (ident a))
245      ]      ]
246    
247    ];    ];
# Line 272  Line 270 
270   fun_decl: [   fun_decl: [
271  (* need an hack to do this, because both productions would  (* need an hack to do this, because both productions would
272     match   [ OPT LIDENT; "("; pat ] .... *)     match   [ OPT LIDENT; "("; pat ] .... *)
273     [ f = OPT [ x = LIDENT -> ident (parse_ident x)]; "("; p1 = pat LEVEL "no_arrow";     [ f = OPT [ x = LIDENT -> ident x]; "("; p1 = pat LEVEL "no_arrow";
274      res = [ "->"; p2 = pat;      res = [ "->"; p2 = pat;
275              a = [ ";"; a = LIST0 arrow SEP ";" -> a | -> [] ];              a = [ ";"; a = LIST0 arrow SEP ";" -> a | -> [] ];
276              ")"; b = branches -> `Classic (p2,a,b)              ")"; b = branches -> `Classic (p2,a,b)
# Line 314  Line 312 
312            | _ -> Alt (x,y)            | _ -> Alt (x,y)
313      ]      ]
314    | [ x = regexp; y = regexp -> Seq (x,y) ]    | [ x = regexp; y = regexp -> Seq (x,y) ]
315    | [ a = LIDENT; "::"; x = regexp -> SeqCapture (ident (parse_ident a),x) ]    | [ a = LIDENT; "::"; x = regexp -> SeqCapture (ident a,x) ]
316    | [ x = regexp; "*" -> Star x    | [ x = regexp; "*" -> Star x
317      | x = regexp; "*?" -> WeakStar x      | x = regexp; "*?" -> WeakStar x
318      | x = regexp; "+" -> Seq (x, Star x)      | x = regexp; "+" -> Seq (x, Star x)
# Line 323  Line 321 
321      | x = regexp; "??" -> Alt (Epsilon, x) ]      | x = regexp; "??" -> Alt (Epsilon, x) ]
322    | [ "("; x = regexp; ")" -> x    | [ "("; x = regexp; ")" -> x
323      | "("; a = LIDENT; ":="; c = const; ")" ->      | "("; a = LIDENT; ":="; c = const; ")" ->
324          Elem (mk loc (Constant ((ident (parse_ident a),c))))          Elem (mk loc (Constant ((ident a,c))))
325      | UIDENT "PCDATA" -> string_regexp      | UIDENT "PCDATA" -> string_regexp
326      | i = STRING1; "--"; j = STRING1 ->      | i = STRING1; "--"; j = STRING1 ->
327          let i = Chars.mk_int (parse_char loc i)          let i = Chars.mk_int (parse_char loc i)
# Line 356  Line 354 
354        [ "{"; r = record_spec; "}" -> mk loc (Record (true,r))        [ "{"; r = record_spec; "}" -> mk loc (Record (true,r))
355        | "{|"; r = record_spec; "|}" -> mk loc (Record (false,r))        | "{|"; r = record_spec; "|}" -> mk loc (Record (false,r))
356        | LIDENT "_" -> mk loc (Internal Types.any)        | LIDENT "_" -> mk loc (Internal Types.any)
357        | a = LIDENT -> mk loc (Capture (ident (parse_ident a)))        | a = LIDENT -> mk loc (Capture (ident a))
358        | "("; a = LIDENT; ":="; c = const; ")" ->        | "("; a = LIDENT; ":="; c = const; ")" ->
359            mk loc (Constant (ident (parse_ident a),c))            mk loc (Constant (ident a,c))
360        | a = UIDENT -> mk loc (PatVar a)        | a = UIDENT -> mk loc (PatVar a)
361        | i = INT ; "--"; j = INT ->        | i = INT ; "--"; j = INT ->
362            let i =  Intervals.mk i            let i =  Intervals.mk i
# Line 385  Line 383 
383               "]" -> mk loc (Regexp (r,q))               "]" -> mk loc (Regexp (r,q))
384        | "<"; t =        | "<"; t =
385          [ x = [ LIDENT | UIDENT | keyword ] ->          [ x = [ LIDENT | UIDENT | keyword ] ->
386              let a = if x = "_" then Atoms.any else Atoms.atom (Atoms.mk (parse_ident x)) in              let a = if x = "_" then Atoms.any else Atoms.atom (atom x) in
387              mk loc (Internal (Types.atom a))              mk loc (Internal (Types.atom a))
388          | "("; t = pat; ")" -> t ];          | "("; t = pat; ")" -> t ];
389          a = attrib_spec; ">"; c = pat ->          a = attrib_spec; ">"; c = pat ->
# Line 423  Line 421 
421    const:    const:
422      [      [
423        [ i = INT -> Types.Integer (Intervals.mk i)        [ i = INT -> Types.Integer (Intervals.mk i)
424        | "`"; a = [LIDENT | UIDENT | keyword ] -> Types.Atom (Atoms.mk (parse_ident a))        | "`"; a = [LIDENT | UIDENT | keyword ] -> Types.Atom (atom a)
425        | c = char -> Types.Char c ]        | c = char -> Types.Char c ]
426      ];      ];
427    
Legend:
Removed from v.374  
changed lines
  Added in v.375
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5