Source

ocaml-lib / dcg / old / pa_dcg2.ml

Full commit

open Camlp4.PreCast
open Syntax


EXTEND Gram
  GLOBAL: expr;

  expr: LEVEL "top"
    [ [ "dcg"; pcl = parser_case_list ->
          ( match pcl with
	  | [] -> assert false
	  | pc::pcl' ->
              let p = List.fold_left (fun res pc -> <:expr< Dcg.alt $res$ $pc$ >>) pc pcl' in
	      <:expr< fun str -> $p$ str >>)
      ] ];

  parser_case_list:
    [ [ pc = parser_case -> pc
      | pc = parser_case; "|"; pcl = parser_case_list -> pc pcl
      ] ]

(*
  parser_case_list:
    [ [ OPT "|"; pcl = LIST1 parser_case SEP "|" -> pcl
      ] ];
*)

  parser_case:
    [ [ stream_begin; sp = stream_patt; stream_end; "->"; e = expr ->
      match List.rev sp with
      | [] ->
	  let f = <:expr< fun _ -> $e$ >> in
	  <:expr< Dcg.map Dcg.eps $f$ >>
      | (p_last,e_last)::sp' ->
	  let f = <:expr< fun $p_last$ -> $e$ >> in
	  let p = <:expr< Dcg.map $e_last$ $f$ >> in
	  List.fold_left
	    (fun res (p_i,e_i) ->
	      let f = <:expr< fun $p_i$ -> $res$ >> in
	      <:expr< Dcg.seq $e_i$ $f$ >>)
	    p sp' ] ];

  stream_begin:
    [ [ "[<" -> () ] ];

  stream_end:
    [ [ ">]" -> () ] ];

  stream_expr:
    [ [ e = expr LEVEL "top" -> e ] ];

  stream_patt:
    [ [ spc = stream_patt_comp -> [spc]
      | spc = stream_patt_comp; ";"; sp = stream_patt_comp_list ->
          spc::sp
      | -> [] ] ];

  stream_patt_comp:
    [ [ "EOF" -> <:patt< _ >>, <:expr< Matcher.eof >>
      | s = a_STRING -> <:patt< _ >>, <:expr< Matcher.look $str:s$ >>
      | p = patt; "="; e = stream_expr; bo = OPT [ "when"; b = stream_expr; "??"; s = a_STRING -> b, s ] ->
	  ( match bo with
	  | None -> p, e
	  | Some (b, s) ->
	      let f = <:expr< fun $p$ -> $b$ >> in
              p, <:expr< Dcg.guard $e$ $str:s$ $f$ >>)
      ] ];

  stream_patt_comp_list:
    [ [ spc = stream_patt_comp -> [spc]
      | spc = stream_patt_comp; ";" -> [spc]
      | spc = stream_patt_comp; ";"; sp = stream_patt_comp_list ->
          spc::sp ] ];

END;