ocaml-lib / dcg / pa_dcg.ml

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;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.