Source

ocaml-lib / dcg / pa_dcg.ml

Full commit
Sébastien Ferré 86c70bb 
Sébastien Ferré fba87cc 

Sébastien Ferré 86c70bb 
Sébastien Ferré fba87cc 

Sébastien Ferré 86c70bb 

Sébastien Ferré f08163b 

Sébastien Ferré c8625db 
Sébastien Ferré 7514e8a 








Sébastien Ferré 86c70bb 

Sébastien Ferré fba87cc 

Sébastien Ferré 86c70bb 
Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 


Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 

Sébastien Ferré fba87cc 
Sébastien Ferré b9f7d6b 
Sébastien Ferré 7514e8a 
Sébastien Ferré efa6d6f 




Sébastien Ferré 86c70bb 

Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 
Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 


Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 








Sébastien Ferré b9f7d6b 
Sébastien Ferré 86c70bb 
Sébastien Ferré efa6d6f 


Sébastien Ferré c8625db 



Sébastien Ferré 86c70bb 
Sébastien Ferré 4fdd04a 
Sébastien Ferré 5733406 









Sébastien Ferré fba87cc 

Sébastien Ferré 5733406 
Sébastien Ferré fba87cc 
Sébastien Ferré 5733406 


Sébastien Ferré 86c70bb 


Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 

Sébastien Ferré efa6d6f 

Sébastien Ferré 86c70bb 




Sébastien Ferré 4fdd04a 
Sébastien Ferré 7514e8a 



Sébastien Ferré 4fdd04a 
Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 

Sébastien Ferré efa6d6f 




Sébastien Ferré 86c70bb 
Sébastien Ferré fba87cc 

Sébastien Ferré 86c70bb 


Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 
Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 
Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 

Sébastien Ferré fba87cc 
Sébastien Ferré 86c70bb 

open Camlp4.PreCast
open Syntax

EXTEND Gram
  GLOBAL: expr;

  expr: LEVEL "top"
      [ [ "dcg"; eo = OPT [ s = str -> s ]; p = rule ->
	( match eo with
	| None -> <:expr< fun ctx str -> $p$ ctx str >>
	| Some e -> <:expr< fun ctx str -> $p$ ctx str >>) ] ];
(*
	    if !Dcg.trace then begin
	      prerr_string "dcg > "; prerr_endline $e$; flush stderr;
	      let res = $p$ ctx str in
	      prerr_string "dcg < "; prerr_endline $e$; flush stderr;
	      res end
	    else $p$ ctx str >>) ] ];
*)

  rule:
      [ [ "["; OPT "|"; p = alt; "]" -> p ] ];
    
  alt:
      [ [ p1 = seq; p2o = OPT [ "|"; p2 = alt -> p2 ] ->
        match p2o with
	| None -> p1
	| Some p2 -> <:expr< Dcg.alt $p1$ $p2$ >>
	] ];

  seq:
      [ [ "->"; e = expr ->
	    <:expr< Dcg.ret $e$ >>
        | (x1,p1) = atom; "then"; p2 = seq2; "|"; p3 = alt ->
	    let f = <:expr< fun $pat:x1$ -> $p2$ >> in
	    <:expr< Dcg.cut $p1$ $f$ $p3$ >>
        | (x1,p1) = atom; f2 = seq1 ->
            f2 (x1,p1)
        ] ];

  seq1:
    [ [ "->"; e = expr ->
        (fun (x,p) ->
	  let f = <:expr< fun $pat:x$ -> $e$ >> in
          <:expr< Dcg.map $p$ $f$ >>)
      | ";"; p2 = seq2 ->
        (fun (x1,p1) ->
	  let f = <:expr< fun $pat:x1$ -> $p2$ >> in
          <:expr< Dcg.seq $p1$ $f$ >>)
      ] ];

  seq2:
    [ [ (x1, p1) = atom; f2 = seq1 -> f2 (x1,p1) 
      | "("; OPT "|"; p = alt; ")" -> p
      ] ];

  atom:
    [ [ "EOF" ->
        <:patt< _ >>, <:expr< Matcher.eof >>
      | "when"; s = str; e = expr LEVEL "top" ->
	  let f = <:expr< fun () -> $e$ >> in
	  <:patt< _ >>, <:expr< Dcg.check $s$ $f$ >>
      | "?"; x = ipatt ->
	  x, <:expr< Dcg.get_context >>
      | "!"; e = expr LEVEL "top" ->
	  <:patt< _ >>, <:expr< Dcg.set_context $e$ >>
      | s = str ->
          <:patt< _ >>, <:expr< Matcher.look $s$ >>
      | x = ipatt; ff = binding ->
        x, ff x
      ] ];
 
  binding:
    [ [ "in"; s = str; e = expr LEVEL "top" ->
        (fun x ->
	  let f = <:expr< fun () -> $e$ >> in
	  <:expr< Dcg.enum $s$ $f$ >>)
      | "="; p = quantif; eo = OPT [ "when"; s = str; e = expr LEVEL "top" -> (s,e) ] -> 
        ( match eo with
	| None ->
            (fun x -> p) 
        | Some (s,e) ->
	    (fun x ->
	      let f = <:expr< fun $pat:x$ -> $e$ >> in
              <:expr< Dcg.guard $p$ $s$ $f$ >>))
      ] ];

  quantif:
    [ [ "OPT"; p = par; "ELSE"; x = expr LEVEL "top" -> <:expr< Dcg.opt $p$ $x$ >>
      | "MANY"; p = par -> <:expr< Dcg.many $p$ >>
      | "SOME"; p = par -> <:expr< Dcg.some $p$ >>
      | "LIST0"; p = par; "SEP"; s = sep -> <:expr< Dcg.list0 $p$ $s$ >>
      | "LIST1"; p = par; "SEP"; s = sep -> <:expr< Dcg.list1 $p$ $s$ >> ]
    | [ p = par -> p
      ] ];

  par:
    [ [ p = rule -> p
      | "match"; regexp = expr LEVEL "top"; name_opt = OPT [ "as"; n = str -> n ] ->
	  let name =
	    match name_opt with
	    | Some n -> n
	    | None -> <:expr< ("regexp \"" ^ String.escaped $regexp$ ^ "\"") >> in
	  <:expr< Matcher.get $name$ (Str.regexp $regexp$) Matcher.Token.repr >>
      | p = expr LEVEL "top" -> p
      ] ];

  sep:
    [ [ s = str -> <:expr< Matcher.look $s$ >>
      | p = par -> p
      ] ];

  str:
    [ [ s = a_STRING -> <:expr< $str:s$ >>
      | "'"; e = expr LEVEL "simple" -> <:expr< $e$ >>
(*      | u = UIDENT; "."; i = LIDENT -> <:expr< $uid:u$ . $lid:i$ >> *)
      ] ];

(*
  pat:
    [ [ xl = LIST1 [ "_" -> $_$ | i = a_LIDENT -> $lid:i$ ] SEP "," ->
        match xl with
(*	| [x] -> <:patt< $x$ >> *)
	| _ -> <:patt< ( $list:xl$ ) >>
      ] ];
*)

END;