(* camlp4r *)
(* This file has been generated by program: do not edit! *)

(*
Added statements:

  At toplevel (structure item):

     DEFINE <uident>
     DEFINE <uident> = <expression>
     DEFINE <uident> (<parameters>) = <expression>
     IFDEF <uident> THEN <structure_items> (END | ENDIF)
     IFDEF <uident> THEN <structure_items> ELSE <structure_items> (END | ENDIF)
     IFNDEF <uident> THEN <structure_items> (END | ENDIF)
     IFNDEF <uident> THEN <structure_items> ELSE <structure_items> (END | ENDIF)
     INCLUDE <string>

  In expressions:

     IFDEF <uident> THEN <expression> ELSE <expression> (END | ENDIF)
     IFNDEF <uident> THEN <expression> ELSE <expression> (END | ENDIF)
     __FILE__
     __LOCATION__

  In patterns:

     IFDEF <uident> THEN <pattern> ELSE <pattern> (END | ENDIF)
     IFNDEF <uident> THEN <pattern> ELSE <pattern> (END | ENDIF)

  As Camlp4 options:

     -D<uident>                      define <uident>
     -U<uident>                      undefine it
     -I<dir>                         add <dir> to the search path for INCLUDE'd files

  After having used a DEFINE <uident> followed by "= <expression>", you
  can use it in expressions *and* in patterns. If the expression defining
  the macro cannot be used as a pattern, there is an error message if
  it is used in a pattern.

  

  The toplevel statement INCLUDE <string> can be used to include a
  file containing macro definitions; note that files included in such
  a way can not have any non-macro toplevel items.  The included files
  are looked up in directories passed in via the -I option, falling
  back to the current directory.

  The expression __FILE__ returns the current compiled file name.
  The expression __LOCATION__ returns the current location of itself.

*)

(* #load "pa_extend.cmo" *)
(* #load "q_MLast.cmo" *)

open Pcaml;;

type 'a item_or_def =
    SdStr of 'a
  | SdDef of string * (string list * MLast.expr) option
  | SdUnd of string
  | SdITE of string * 'a item_or_def list * 'a item_or_def list
  | SdInc of string
;;

let rec list_remove x =
  function
    (y, _) :: l when y = x -> l
  | d :: l -> d :: list_remove x l
  | [] -> []
;;

let defined = ref [];;

let is_defined i = List.mem_assoc i !defined;;

let _loc =
  let nowhere =
    {(Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0}
  in
  nowhere, nowhere
;;

let subst mloc env =
  let rec loop =
    function
      MLast.ExLet (_, rf, pel, e) ->
        let pel = List.map (fun (p, e) -> p, loop e) pel in
        MLast.ExLet (_loc, rf, pel, loop e)
    | MLast.ExIfe (_, e1, e2, e3) ->
        MLast.ExIfe (_loc, loop e1, loop e2, loop e3)
    | MLast.ExApp (_, e1, e2) -> MLast.ExApp (_loc, loop e1, loop e2)
    | MLast.ExFun (_, [args, None, e]) ->
        MLast.ExFun (_loc, [args, None, loop e])
    | MLast.ExFun (_, peoel) -> MLast.ExFun (_loc, List.map loop_peoel peoel)
    | MLast.ExLid (_, x) | MLast.ExUid (_, x) as e ->
        begin try MLast.ExAnt (_loc, List.assoc x env) with
          Not_found -> e
        end
    | MLast.ExTup (_, x) -> MLast.ExTup (_loc, List.map loop x)
    | MLast.ExSeq (_, x) -> MLast.ExSeq (_loc, List.map loop x)
    | MLast.ExRec (_, pel, None) ->
        let pel = List.map (fun (p, e) -> p, loop e) pel in
        MLast.ExRec (_loc, pel, None)
    | MLast.ExMat (_, e, peoel) ->
        MLast.ExMat (_loc, loop e, List.map loop_peoel peoel)
    | MLast.ExTry (_, e, pel) ->
        let loop' =
          function
            p, Some e1, e2 -> p, Some (loop e1), loop e2
          | p, None, e2 -> p, None, loop e2
        in
        MLast.ExTry (_loc, loop e, List.map loop' pel)
    | e -> e
  and loop_peoel =
    function
      p, Some e1, e2 -> p, Some (loop e1), loop e2
    | p, None, e2 -> p, None, loop e2
  in
  loop
;;

let substp mloc env =
  let rec loop =
    function
      MLast.ExApp (_, e1, e2) -> MLast.PaApp (_loc, loop e1, loop e2)
    | MLast.ExLid (_, x) ->
        begin try MLast.PaAnt (_loc, List.assoc x env) with
          Not_found -> MLast.PaLid (_loc, x)
        end
    | MLast.ExUid (_, x) ->
        begin try MLast.PaAnt (_loc, List.assoc x env) with
          Not_found -> MLast.PaUid (_loc, x)
        end
    | MLast.ExInt (_, x) -> MLast.PaInt (_loc, x)
    | MLast.ExStr (_, s) -> MLast.PaStr (_loc, s)
    | MLast.ExTup (_, x) -> MLast.PaTup (_loc, List.map loop x)
    | MLast.ExRec (_, pel, None) ->
        let ppl = List.map (fun (p, e) -> p, loop e) pel in
        MLast.PaRec (_loc, ppl)
    | x ->
        Stdpp.raise_with_loc mloc
          (Failure
             "this macro cannot be used in a pattern (see its definition)")
  in
  loop
;;

let incorrect_number loc l1 l2 =
  Stdpp.raise_with_loc loc
    (Failure
       (Printf.sprintf "expected %d parameters; found %d" (List.length l2)
          (List.length l1)))
;;

let define eo x =
  begin match eo with
    Some ([], e) ->
      Grammar.extend
        [Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
         Some (Gramext.Level "simple"),
         [None, None,
          [[Gramext.Stoken ("UIDENT", x)],
           Gramext.action
             (fun _ (_loc : Lexing.position * Lexing.position) ->
                (Pcaml.expr_reloc (fun _ -> _loc) (fst _loc) e : 'expr))]];
         Grammar.Entry.obj (patt : 'patt Grammar.Entry.e),
         Some (Gramext.Level "simple"),
         [None, None,
          [[Gramext.Stoken ("UIDENT", x)],
           Gramext.action
             (fun _ (_loc : Lexing.position * Lexing.position) ->
                (let p = substp _loc [] e in
                 Pcaml.patt_reloc (fun _ -> _loc) (fst _loc) p :
                 'patt))]]]
  | Some (sl, e) ->
      Grammar.extend
        [Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
         Some (Gramext.Level "apply"),
         [None, None,
          [[Gramext.Stoken ("UIDENT", x); Gramext.Sself],
           Gramext.action
             (fun (param : 'expr) _
                (_loc : Lexing.position * Lexing.position) ->
                (let el =
                   match param with
                     MLast.ExTup (_, el) -> el
                   | e -> [e]
                 in
                 if List.length el = List.length sl then
                   let env = List.combine sl el in
                   let e = subst _loc env e in
                   Pcaml.expr_reloc (fun _ -> _loc) (fst _loc) e
                 else incorrect_number _loc el sl :
                 'expr))]];
         Grammar.Entry.obj (patt : 'patt Grammar.Entry.e),
         Some (Gramext.Level "simple"),
         [None, None,
          [[Gramext.Stoken ("UIDENT", x); Gramext.Sself],
           Gramext.action
             (fun (param : 'patt) _
                (_loc : Lexing.position * Lexing.position) ->
                (let pl =
                   match param with
                     MLast.PaTup (_, pl) -> pl
                   | p -> [p]
                 in
                 if List.length pl = List.length sl then
                   let env = List.combine sl pl in
                   let p = substp _loc env e in
                   Pcaml.patt_reloc (fun _ -> _loc) (fst _loc) p
                 else incorrect_number _loc pl sl :
                 'patt))]]]
  | None -> ()
  end;
  defined := (x, eo) :: !defined
;;

let undef x =
  try
    let eo = List.assoc x !defined in
    begin match eo with
      Some ([], _) ->
        Grammar.delete_rule expr [Gramext.Stoken ("UIDENT", x)];
        Grammar.delete_rule patt [Gramext.Stoken ("UIDENT", x)]
    | Some (_, _) ->
        Grammar.delete_rule expr
          [Gramext.Stoken ("UIDENT", x); Gramext.Sself];
        Grammar.delete_rule patt [Gramext.Stoken ("UIDENT", x); Gramext.Sself]
    | None -> ()
    end;
    defined := list_remove x !defined
  with
    Not_found -> ()
;;

(* This is a list of directories to search for INCLUDE statements. *)
let include_dirs = ref [];;

(* Add something to the above, make sure it ends with a slash. *)
let add_include_dir str =
  if str <> "" then
    let str =
      if String.get str (String.length str - 1) = '/' then str else str ^ "/"
    in
    include_dirs := !include_dirs @ [str]
;;

let smlist = Grammar.Entry.create Pcaml.gram "smlist";;

let parse_include_file =
  let dir_ok file dir = Sys.file_exists (dir ^ file) in
  fun file ->
    let file =
      try List.find (dir_ok file) (!include_dirs @ ["./"]) ^ file with
        Not_found -> file
    in
    let ch = open_in file in
    let st = Stream.of_channel ch in
    let old_input = !(Pcaml.input_file) in
    let (bol_ref, lnum_ref, name_ref) = !(Pcaml.position) in
    let (old_bol, old_lnum, old_name) = !bol_ref, !lnum_ref, !name_ref in
    let restore () =
      close_in ch;
      bol_ref := old_bol;
      lnum_ref := old_lnum;
      name_ref := old_name;
      Pcaml.input_file := old_input
    in
    bol_ref := 0;
    lnum_ref := 1;
    name_ref := file;
    Pcaml.input_file := file;
    try let items = Grammar.Entry.parse smlist st in restore (); items with
      exn -> restore (); raise exn
;;

let rec execute_macro =
  function
    SdStr i -> [i]
  | SdDef (x, eo) -> define eo x; []
  | SdUnd x -> undef x; []
  | SdITE (i, l1, l2) -> execute_macro_list (if is_defined i then l1 else l2)
  | SdInc f -> execute_macro_list (parse_include_file f)
and execute_macro_list =
  function
    [] -> []
  | hd :: tl ->
      let il1 = execute_macro hd in
      let il2 = execute_macro_list tl in il1 @ il2
;; 

Grammar.extend
  (let _ = (expr : 'expr Grammar.Entry.e)
   and _ = (patt : 'patt Grammar.Entry.e)
   and _ = (str_item : 'str_item Grammar.Entry.e)
   and _ = (sig_item : 'sig_item Grammar.Entry.e)
   and _ = (smlist : 'smlist Grammar.Entry.e) in
   let grammar_entry_create s =
     Grammar.Entry.create (Grammar.of_entry expr) s
   in
   let macro_def : 'macro_def Grammar.Entry.e =
     grammar_entry_create "macro_def"
   and endif : 'endif Grammar.Entry.e = grammar_entry_create "endif"
   and str_item_or_macro : 'str_item_or_macro Grammar.Entry.e =
     grammar_entry_create "str_item_or_macro"
   and opt_macro_value : 'opt_macro_value Grammar.Entry.e =
     grammar_entry_create "opt_macro_value"
   and uident : 'uident Grammar.Entry.e = grammar_entry_create "uident" in
   [Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e),
    Some Gramext.First,
    [None, None,
     [[Gramext.Snterm
         (Grammar.Entry.obj (macro_def : 'macro_def Grammar.Entry.e))],
      Gramext.action
        (fun (x : 'macro_def) (_loc : Lexing.position * Lexing.position) ->
           (match execute_macro x with
              [si] -> si
            | sil -> MLast.StDcl (_loc, sil) :
            'str_item))]];
    Grammar.Entry.obj (macro_def : 'macro_def Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("", "INCLUDE"); Gramext.Stoken ("STRING", "")],
      Gramext.action
        (fun (fname : string) _ (_loc : Lexing.position * Lexing.position) ->
           (SdInc fname : 'macro_def));
      [Gramext.Stoken ("", "IFNDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Stoken ("", "THEN");
       Gramext.Snterm (Grammar.Entry.obj (smlist : 'smlist Grammar.Entry.e));
       Gramext.Stoken ("", "ELSE");
       Gramext.Snterm (Grammar.Entry.obj (smlist : 'smlist Grammar.Entry.e));
       Gramext.Snterm (Grammar.Entry.obj (endif : 'endif Grammar.Entry.e))],
      Gramext.action
        (fun (_ : 'endif) (dl2 : 'smlist) _ (dl1 : 'smlist) _ (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (SdITE (i, dl2, dl1) : 'macro_def));
      [Gramext.Stoken ("", "IFNDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Stoken ("", "THEN");
       Gramext.Snterm (Grammar.Entry.obj (smlist : 'smlist Grammar.Entry.e));
       Gramext.Snterm (Grammar.Entry.obj (endif : 'endif Grammar.Entry.e))],
      Gramext.action
        (fun (_ : 'endif) (dl : 'smlist) _ (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (SdITE (i, [], dl) : 'macro_def));
      [Gramext.Stoken ("", "IFDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Stoken ("", "THEN");
       Gramext.Snterm (Grammar.Entry.obj (smlist : 'smlist Grammar.Entry.e));
       Gramext.Stoken ("", "ELSE");
       Gramext.Snterm (Grammar.Entry.obj (smlist : 'smlist Grammar.Entry.e));
       Gramext.Snterm (Grammar.Entry.obj (endif : 'endif Grammar.Entry.e))],
      Gramext.action
        (fun (_ : 'endif) (dl2 : 'smlist) _ (dl1 : 'smlist) _ (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (SdITE (i, dl1, dl2) : 'macro_def));
      [Gramext.Stoken ("", "IFDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Stoken ("", "THEN");
       Gramext.Snterm (Grammar.Entry.obj (smlist : 'smlist Grammar.Entry.e));
       Gramext.Snterm (Grammar.Entry.obj (endif : 'endif Grammar.Entry.e))],
      Gramext.action
        (fun (_ : 'endif) (dl : 'smlist) _ (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (SdITE (i, dl, []) : 'macro_def));
      [Gramext.Stoken ("", "UNDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e))],
      Gramext.action
        (fun (i : 'uident) _ (_loc : Lexing.position * Lexing.position) ->
           (SdUnd i : 'macro_def));
      [Gramext.Stoken ("", "DEFINE");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Snterm
         (Grammar.Entry.obj
            (opt_macro_value : 'opt_macro_value Grammar.Entry.e))],
      Gramext.action
        (fun (def : 'opt_macro_value) (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (SdDef (i, def) : 'macro_def))]];
    Grammar.Entry.obj (smlist : 'smlist Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Slist1
         (Gramext.Snterm
            (Grammar.Entry.obj
               (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e)))],
      Gramext.action
        (fun (sml : 'str_item_or_macro list)
           (_loc : Lexing.position * Lexing.position) ->
           (sml : 'smlist))]];
    Grammar.Entry.obj (endif : 'endif Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("", "ENDIF")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) -> (() : 'endif));
      [Gramext.Stoken ("", "END")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) -> (() : 'endif))]];
    Grammar.Entry.obj
      (str_item_or_macro : 'str_item_or_macro Grammar.Entry.e),
    None,
    [None, None,
     [[Gramext.Snterm
         (Grammar.Entry.obj (str_item : 'str_item Grammar.Entry.e))],
      Gramext.action
        (fun (si : 'str_item) (_loc : Lexing.position * Lexing.position) ->
           (SdStr si : 'str_item_or_macro));
      [Gramext.Snterm
         (Grammar.Entry.obj (macro_def : 'macro_def Grammar.Entry.e))],
      Gramext.action
        (fun (d : 'macro_def) (_loc : Lexing.position * Lexing.position) ->
           (d : 'str_item_or_macro))]];
    Grammar.Entry.obj (opt_macro_value : 'opt_macro_value Grammar.Entry.e),
    None,
    [None, None,
     [[],
      Gramext.action
        (fun (_loc : Lexing.position * Lexing.position) ->
           (None : 'opt_macro_value));
      [Gramext.Stoken ("", "=");
       Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
      Gramext.action
        (fun (e : 'expr) _ (_loc : Lexing.position * Lexing.position) ->
           (Some ([], e) : 'opt_macro_value));
      [Gramext.Stoken ("", "(");
       Gramext.Slist1sep
         (Gramext.Stoken ("LIDENT", ""), Gramext.Stoken ("", ","));
       Gramext.Stoken ("", ")"); Gramext.Stoken ("", "=");
       Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
      Gramext.action
        (fun (e : 'expr) _ _ (pl : string list) _
           (_loc : Lexing.position * Lexing.position) ->
           (Some (pl, e) : 'opt_macro_value))]];
    Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
    Some (Gramext.Level "top"),
    [None, None,
     [[Gramext.Stoken ("", "IFNDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Stoken ("", "THEN"); Gramext.Sself;
       Gramext.Stoken ("", "ELSE"); Gramext.Sself;
       Gramext.Snterm (Grammar.Entry.obj (endif : 'endif Grammar.Entry.e))],
      Gramext.action
        (fun (_ : 'endif) (e2 : 'expr) _ (e1 : 'expr) _ (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (if is_defined i then e2 else e1 : 'expr));
      [Gramext.Stoken ("", "IFDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Stoken ("", "THEN"); Gramext.Sself;
       Gramext.Stoken ("", "ELSE"); Gramext.Sself;
       Gramext.Snterm (Grammar.Entry.obj (endif : 'endif Grammar.Entry.e))],
      Gramext.action
        (fun (_ : 'endif) (e2 : 'expr) _ (e1 : 'expr) _ (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (if is_defined i then e1 else e2 : 'expr))]];
    Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
    Some (Gramext.Level "simple"),
    [None, None,
     [[Gramext.Stoken ("LIDENT", "__LOCATION__")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) ->
           (let bp = string_of_int (fst _loc).Lexing.pos_cnum in
            let ep = string_of_int (snd _loc).Lexing.pos_cnum in
            MLast.ExTup
              (_loc, [MLast.ExInt (_loc, bp); MLast.ExInt (_loc, ep)]) :
            'expr));
      [Gramext.Stoken ("LIDENT", "__FILE__")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) ->
           (MLast.ExStr (_loc, !(Pcaml.input_file)) : 'expr))]];
    Grammar.Entry.obj (patt : 'patt Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("", "IFNDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Stoken ("", "THEN"); Gramext.Sself;
       Gramext.Stoken ("", "ELSE"); Gramext.Sself;
       Gramext.Snterm (Grammar.Entry.obj (endif : 'endif Grammar.Entry.e))],
      Gramext.action
        (fun (_ : 'endif) (p2 : 'patt) _ (p1 : 'patt) _ (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (if is_defined i then p2 else p1 : 'patt));
      [Gramext.Stoken ("", "IFDEF");
       Gramext.Snterm (Grammar.Entry.obj (uident : 'uident Grammar.Entry.e));
       Gramext.Stoken ("", "THEN"); Gramext.Sself;
       Gramext.Stoken ("", "ELSE"); Gramext.Sself;
       Gramext.Snterm (Grammar.Entry.obj (endif : 'endif Grammar.Entry.e))],
      Gramext.action
        (fun (_ : 'endif) (p2 : 'patt) _ (p1 : 'patt) _ (i : 'uident) _
           (_loc : Lexing.position * Lexing.position) ->
           (if is_defined i then p1 else p2 : 'patt))]];
    Grammar.Entry.obj (uident : 'uident Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("UIDENT", "")],
      Gramext.action
        (fun (i : string) (_loc : Lexing.position * Lexing.position) ->
           (i : 'uident))]]]);;

Pcaml.add_option "-D" (Arg.String (define None))
  "<string> Define for IFDEF instruction.";;
Pcaml.add_option "-U" (Arg.String undef)
  "<string> Undefine for IFDEF instruction.";;
Pcaml.add_option "-I" (Arg.String add_include_dir)
  "<string> Add a directory to INCLUDE search path.";;