# ocaml-lib / dcg / pa_dcg.ml

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106``` ``` open Camlp4.PreCast open Syntax EXTEND Gram GLOBAL: expr; expr: LEVEL "top" [ [ "dcg"; p = rule -> <:expr< fun str -> \$p\$ 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 -> let p = <:expr< Dcg.eps >> in let f = <:expr< fun _ -> \$e\$ >> in <:expr< Dcg.map \$p\$ \$f\$ >> | (x1,p1) = atom; ";"; "!"; ";"; 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: [ [ "EPS" -> <:patt< _ >>, <:expr< Dcg.eps >> | "EOF" -> <:patt< _ >>, <:expr< Matcher.eof >> | "when"; s = str; e = expr LEVEL "top" -> let f = <:expr< fun () -> \$e\$ >> in <:patt< _ >>, <:expr< Dcg.check \$s\$ \$f\$ >> | s = str -> <:patt< _ >>, <:expr< Matcher.look \$s\$ >> | x = ipatt; "="; p = quantif; eo = OPT [ "when"; s = str; e = expr LEVEL "top" -> (s,e) ] -> ( match eo with | None -> x, p | Some (s,e) -> let f = <:expr< fun \$pat:x\$ -> \$e\$ >> in x, <: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\$ >> ] (* | "LIST0"; p = par; "SEP"; s = expr LEVEL "simple" -> let sep = <:expr< Matcher.look \$s\$ >> in <:expr< Dcg.list0 \$p\$ \$sep\$ >> | "LIST1"; p = par; "SEP"; s = expr LEVEL "simple" -> let sep = <:expr< Matcher.look \$s\$ >> in <:expr< Dcg.list1 \$p\$ \$sep\$ >> ] *) | [ p = par -> p ] ]; par: [ [ p = rule -> p | 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; ```