1. Sébastien Ferré
  2. ocaml-lib

Source

ocaml-lib / dcg / pa_dcg.ml


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;