Source

orakuda / pa / pa_command.ml

The default branch has multiple heads

open Camlp4                                             (* -*- camlp4of -*- *)

module Id : Sig.Id = struct
  let name = "pa_command"
  let version = "1.0"
end

module Make (Syntax : Sig.Camlp4Syntax) = struct
  (* open Sig *)
  include Syntax

  module Pa_format = Pa_format.Make(Syntax) 

  let parse _loc _loc_var_opt s =
    match Pa_format.parse ['`'] _loc _loc_var_opt s with
    | (`Const _ | `Fun _), pos, rem when rem <> "" -> 
        raise (Lexformat.Error (pos, pos + 1,
		                Printf.sprintf "Unescaped special character %C found" rem.[0]))
    | `Const s, _, _ -> <:expr<command $s$>>
    | `Fun (_abss, f), _, _ -> 
	f <:expr<
	    Printf.ksprintf command
	  >>
  ;;

  let _ =
    Syntax.Quotation.add "qx"
      Syntax.Quotation.DynAst.expr_tag
      parse;

   Syntax.Quotation.add "qx"
      Syntax.Quotation.DynAst.str_item_tag
      (fun _loc _loc_var_opt s ->
	let e = parse _loc _loc_var_opt s in
	<:str_item< $exp:e$ >>)
    ;;
end


let module M = Register.OCamlSyntaxExtension(Id)(Make) in ()