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é be350c1 


Sébastien Ferré efa6d6f 

Sébastien Ferré be350c1 
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é be350c1 
Sébastien Ferré 86c70bb 


Sébastien Ferré be350c1 
Sébastien Ferré b9f7d6b 
Sébastien Ferré 86c70bb 
Sébastien Ferré efa6d6f 
Sébastien Ferré 7a69181 
Sébastien Ferré efa6d6f 
Sébastien Ferré 7a69181 

Sébastien Ferré c8625db 



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




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é be350c1 
Sébastien Ferré 4fdd04a 
Sébastien Ferré d189db7 


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$ >>
	| "exception"; e = expr LEVEL "top" ->
            <:expr< Dcg.raise_exn $e$ >>
        | (x1,p1) = dcg_atom; "then"; p2 = seq2; "|"; p3 = alt ->
	    let f = <:expr< fun $pat:x1$ -> $p2$ >> in
	    <:expr< Dcg.cut $p1$ $f$ $p3$ >>
        | (x1,p1) = dcg_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) = dcg_atom; f2 = seq1 -> f2 (x1,p1) 
      | "("; OPT "|"; p = alt; ")" -> p
      ] ];

  dcg_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.rise >>
      | "?"; 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
(* does not work because non-empty intersection between patterns and expressions (e.g., identifiers)
      | p = quantif ->
	  <:patt< _ >>, p
*)
      ] ];
 
  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 >>
      | "try"; e = expr LEVEL "top" ->
	  let f = <:expr< fun () -> $e$ >> in
	  <:expr< Dcg.trial $f$ >>
      | 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;