Commits

Sébastien Ferré committed 86c70bb

Initial revision

  • Participants
  • Parent commits 400d364

Comments (0)

Files changed (1)

+
+open Pcaml
+
+EXTEND
+  GLOBAL: expr str_item;
+
+  expr: LEVEL "top"
+    [ [ "rule"; p = rule -> p ] ];
+
+  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 LEVEL "expr1" ->
+          let p = <:expr< Dcg.eps >> in
+	  let pwel = [(<:patt< _ >>, None, e)] in
+	  let f = <:expr< fun [ $list:pwel$ ] >> in
+	  <:expr< Dcg.map $p$ $f$ >>
+      | (x1,p1) = atom; "!"; p2 = seq2; "|"; p3 = alt ->
+	  let pwel = [(<:patt< $x1$ >>, None, p2)] in
+          let f = <:expr< fun [ $list:pwel$ ] >> in
+	  <:expr< Dcg.cut $p1$ $f$ $p3$ >>
+      | (x1,p1) = atom; f2 = seq1 ->
+          f2 (x1,p1)
+      ] ];
+
+  seq1:
+    [ [ "->"; e = expr LEVEL "expr1" ->
+        (fun (x,p) ->
+          let pwel = [(<:patt< $x$ >>, None, e)] in
+          let f = <:expr< fun [ $list:pwel$ ] >> in
+          <:expr< Dcg.map $p$ $f$ >>)
+      | ";"; p2 = seq2 ->
+        (fun (x1,p1) ->
+          let pwel = [(<:patt< $x1$ >>, None, p2)] in
+	  let f = <:expr< fun [ $list:pwel$ ] >> in
+          <:expr< Dcg.seq $p1$ $f$ >>)
+      ] ];
+
+  seq2:
+    [ [ (x1, p1) = atom; f2 = seq1 -> f2 (x1,p1) 
+      | "("; OPT "|"; p = alt; ")" -> p
+      ] ];
+
+  atom:
+    [ [ x = pat; "="; p = quantif; eo = OPT [ "when"; s = str; e = expr LEVEL "expr1" -> (s,e) ] -> 
+        ( match eo with
+	| None ->
+            x, p 
+        | Some (s,e) ->
+	    let pwel = [(<:patt< $x$ >>, None, e)] in
+            let f = <:expr< fun [ $list:pwel$ ] >> in
+            x, <:expr< Dcg.guard $p$ $s$ $f$ >>)
+      | "EPS" ->
+        <:patt< _ >>, <:expr< Dcg.eps >>
+      | "EOF" ->
+        <:patt< _ >>, <:expr< Matcher.eof >>
+      | s = str ->
+        <:patt< _ >>, <:expr< Matcher.look $s$ >>
+      ] ];
+
+  quantif:
+    [ [ "OPT"; p = par -> <:expr< Dcg.opt $p$ >>
+      | "MANY"; p = par -> <:expr< Dcg.many $p$ >>
+      | "SOME"; p = par -> <:expr< Dcg.some $p$ >>
+      | "LISTO"; p = par; "SEP"; s = expr LEVEL "expr1" -> let sep = <:expr< Matcher.look $s$ >> in <:expr< Dcg.list0 $p$ $sep$ >>
+      | "LIST1"; p = par; "SEP"; s = expr LEVEL "expr1" -> let sep = <:expr< Matcher.look $s$ >> in <:expr< Dcg.list1 $p$ $sep$ >> ]
+    | [ p = par -> p
+      ] ];
+
+  par:
+    [ [ p = rule -> p
+      | p = expr LEVEL "expr1" -> p
+      ] ];
+
+  str:
+    [ [ s = STRING -> <:expr< $str:s$ >>
+      | "'"; e = expr LEVEL "expr1" -> <:expr< $e$ >>
+(*      | u = UIDENT; "."; i = LIDENT -> <:expr< $uid:u$ . $lid:i$ >> *)
+      ] ];
+
+  pat:
+    [ [ xl = LIST1 [ "_" -> <:patt< _ >> | i = LIDENT -> <:patt< $lid:i$ >> ] SEP "," ->
+        match xl with
+	| [x] -> x
+	| _ -> <:patt< ( $list:xl$ ) >>
+      ] ];
+
+END;