(* camlp4r pa_extend.cmo q_MLast.cmo *)
(***********************************************************************)
(*                                                                     *)
(*                             Camlp4                                  *)
(*                                                                     *)
(*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
(*                                                                     *)
(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
(*  Automatique.  Distributed only by permission.                      *)
(*                                                                     *)
(***********************************************************************)

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

open Stdpp;;

let split_ext = ref false;;

Pcaml.add_option "-split_ext" (Arg.Set split_ext)
  "Split EXTEND by functions to turn around a PowerPC problem.";;

Pcaml.add_option "-split_gext" (Arg.Set split_ext)
  "Old name for the option -split_ext.";;

type loc = int * int;;

type 'e name = { expr : 'e; tvar : string; loc : int * int };;

type styp =
    STlid of loc * string
  | STapp of loc * styp * styp
  | STquo of loc * string
  | STself of loc * string
  | STtyp of MLast.ctyp
;;

type 'e text =
    TXmeta of loc * string * 'e text list * 'e * styp
  | TXlist of loc * bool * 'e text * 'e text option
  | TXnext of loc
  | TXnterm of loc * 'e name * string option
  | TXopt of loc * 'e text
  | TXrules of loc * ('e text list * 'e) list
  | TXself of loc
  | TXtok of loc * string * 'e
;;

type ('e, 'p) entry =
  { name : 'e name; pos : 'e option; levels : ('e, 'p) level list }
and ('e, 'p) level =
  { label : string option; assoc : 'e option; rules : ('e, 'p) rule list }
and ('e, 'p) rule = { prod : ('e, 'p) psymbol list; action : 'e option }
and ('e, 'p) psymbol = { pattern : 'p option; symbol : ('e, 'p) symbol }
and ('e, 'p) symbol = { used : string list; text : 'e text; styp : styp }
;;

type used =
    Unused
  | UsedScanned
  | UsedNotScanned
;;

let mark_used modif ht n =
  try
    let rll = Hashtbl.find_all ht n in
    List.iter
      (fun (r, _) ->
         if !r == Unused then begin r := UsedNotScanned; modif := true end)
      rll
  with
    Not_found -> ()
;;

let rec mark_symbol modif ht symb =
  List.iter (fun e -> mark_used modif ht e) symb.used
;;

let check_use nl el =
  let ht = Hashtbl.create 301 in
  let modif = ref false in
  List.iter
    (fun e ->
       let u =
         match e.name.expr with
           MLast.ExLid (_, _) -> Unused
         | _ -> UsedNotScanned
       in
       Hashtbl.add ht e.name.tvar (ref u, e))
    el;
  List.iter
    (fun n ->
       try
         let rll = Hashtbl.find_all ht n.tvar in
         List.iter (fun (r, _) -> r := UsedNotScanned) rll
       with
         _ -> ())
    nl;
  modif := true;
  while !modif do
    modif := false;
    Hashtbl.iter
      (fun s (r, e) ->
         if !r = UsedNotScanned then
           begin
             r := UsedScanned;
             List.iter
               (fun level ->
                  let rules = level.rules in
                  List.iter
                    (fun rule ->
                       List.iter (fun ps -> mark_symbol modif ht ps.symbol)
                         rule.prod)
                    rules)
               e.levels
           end)
      ht
  done;
  Hashtbl.iter
    (fun s (r, e) ->
       if !r = Unused then
         !(Pcaml.warning) e.name.loc ("Unused local entry \"" ^ s ^ "\""))
    ht
;;

let locate n = let loc = n.loc in n.expr;;

let new_type_var =
  let i = ref 0 in fun () -> incr i; "e__" ^ string_of_int !i
;;

let used_of_rule_list rl =
  List.fold_left
    (fun nl r -> List.fold_left (fun nl s -> s.symbol.used @ nl) nl r.prod) []
    rl
;;

let retype_rule_list_without_patterns loc rl =
  try
    List.map
      (function
         {prod = [{pattern = None; symbol = s}]; action = None} ->
           {prod = [{pattern = Some (MLast.PaLid (loc, "x")); symbol = s}];
            action = Some (MLast.ExLid (loc, "x"))}
       | {prod = []; action = Some _} as r -> r
       | _ -> raise Exit)
      rl
  with
    Exit -> rl
;;

let quotify = ref false;;
let meta_action = ref false;;

module MetaAction =
  struct
    let not_impl f x =
      let desc =
        if Obj.is_block (Obj.repr x) then
          "tag = " ^ string_of_int (Obj.tag (Obj.repr x))
        else "int_val = " ^ string_of_int (Obj.magic x)
      in
      failwith (f ^ ", not impl: " ^ desc)
    ;;
    let loc = 0, 0;;
    let rec mlist mf =
      function
        [] -> MLast.ExUid (loc, "[]")
      | x :: l ->
          MLast.ExApp
            (loc, MLast.ExApp (loc, MLast.ExUid (loc, "::"), mf x),
             mlist mf l)
    ;;
    let moption mf =
      function
        None -> MLast.ExUid (loc, "None")
      | Some x -> MLast.ExApp (loc, MLast.ExUid (loc, "Some"), mf x)
    ;;
    let mbool =
      function
        false -> MLast.ExUid (loc, "False")
      | true -> MLast.ExUid (loc, "True")
    ;;
    let mloc =
      MLast.ExTup (loc, [MLast.ExInt (loc, "0"); MLast.ExInt (loc, "0")])
    ;;
    let rec mexpr =
      function
        MLast.ExAcc (loc, e1, e2) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "ExAcc")),
                   mloc),
                mexpr e1),
             mexpr e2)
      | MLast.ExApp (loc, e1, e2) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "ExApp")),
                   mloc),
                mexpr e1),
             mexpr e2)
      | MLast.ExChr (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExChr")),
                mloc),
             MLast.ExStr (loc, s))
      | MLast.ExFun (loc, pwel) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExFun")),
                mloc),
             mlist mpwe pwel)
      | MLast.ExIfe (loc, e1, e2, e3) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExApp
                     (loc,
                      MLast.ExAcc
                        (loc, MLast.ExUid (loc, "MLast"),
                         MLast.ExUid (loc, "ExIfe")),
                      mloc),
                   mexpr e1),
                mexpr e2),
             mexpr e3)
      | MLast.ExInt (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExInt")),
                mloc),
             MLast.ExStr (loc, s))
      | MLast.ExFlo (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExFlo")),
                mloc),
             MLast.ExStr (loc, s))
      | MLast.ExLet (loc, rf, pel, e) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExApp
                     (loc,
                      MLast.ExAcc
                        (loc, MLast.ExUid (loc, "MLast"),
                         MLast.ExUid (loc, "ExLet")),
                      mloc),
                   mbool rf),
                mlist mpe pel),
             mexpr e)
      | MLast.ExLid (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExLid")),
                mloc),
             MLast.ExStr (loc, s))
      | MLast.ExMat (loc, e, pwel) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "ExMat")),
                   mloc),
                mexpr e),
             mlist mpwe pwel)
      | MLast.ExRec (loc, pel, eo) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "ExRec")),
                   mloc),
                mlist mpe pel),
             moption mexpr eo)
      | MLast.ExSeq (loc, el) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExSeq")),
                mloc),
             mlist mexpr el)
      | MLast.ExSte (loc, e1, e2) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "ExSte")),
                   mloc),
                mexpr e1),
             mexpr e2)
      | MLast.ExStr (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExStr")),
                mloc),
             MLast.ExStr (loc, String.escaped s))
      | MLast.ExTry (loc, e, pwel) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "ExTry")),
                   mloc),
                mexpr e),
             mlist mpwe pwel)
      | MLast.ExTup (loc, el) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExTup")),
                mloc),
             mlist mexpr el)
      | MLast.ExTyc (loc, e, t) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "ExTyc")),
                   mloc),
                mexpr e),
             mctyp t)
      | MLast.ExUid (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "ExUid")),
                mloc),
             MLast.ExStr (loc, s))
      | x -> not_impl "mexpr" x
    and mpatt =
      function
        MLast.PaAcc (loc, p1, p2) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "PaAcc")),
                   mloc),
                mpatt p1),
             mpatt p2)
      | MLast.PaAny loc ->
          MLast.ExApp
            (loc,
             MLast.ExAcc
               (loc, MLast.ExUid (loc, "MLast"), MLast.ExUid (loc, "PaAny")),
             mloc)
      | MLast.PaApp (loc, p1, p2) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "PaApp")),
                   mloc),
                mpatt p1),
             mpatt p2)
      | MLast.PaInt (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "PaInt")),
                mloc),
             MLast.ExStr (loc, s))
      | MLast.PaLid (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "PaLid")),
                mloc),
             MLast.ExStr (loc, s))
      | MLast.PaOrp (loc, p1, p2) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "PaOrp")),
                   mloc),
                mpatt p1),
             mpatt p2)
      | MLast.PaStr (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "PaStr")),
                mloc),
             MLast.ExStr (loc, String.escaped s))
      | MLast.PaTup (loc, pl) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "PaTup")),
                mloc),
             mlist mpatt pl)
      | MLast.PaTyc (loc, p, t) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "PaTyc")),
                   mloc),
                mpatt p),
             mctyp t)
      | MLast.PaUid (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "PaUid")),
                mloc),
             MLast.ExStr (loc, s))
      | x -> not_impl "mpatt" x
    and mctyp =
      function
        MLast.TyAcc (loc, t1, t2) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "TyAcc")),
                   mloc),
                mctyp t1),
             mctyp t2)
      | MLast.TyApp (loc, t1, t2) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, "MLast"),
                      MLast.ExUid (loc, "TyApp")),
                   mloc),
                mctyp t1),
             mctyp t2)
      | MLast.TyLid (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "TyLid")),
                mloc),
             MLast.ExStr (loc, s))
      | MLast.TyQuo (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "TyQuo")),
                mloc),
             MLast.ExStr (loc, s))
      | MLast.TyTup (loc, tl) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "TyTup")),
                mloc),
             mlist mctyp tl)
      | MLast.TyUid (loc, s) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "MLast"),
                   MLast.ExUid (loc, "TyUid")),
                mloc),
             MLast.ExStr (loc, s))
      | x -> not_impl "mctyp" x
    and mpe (p, e) = MLast.ExTup (loc, [mpatt p; mexpr e])
    and mpwe (p, w, e) =
      MLast.ExTup (loc, [mpatt p; moption mexpr w; mexpr e])
    ;;
  end
;;

let mklistexp loc =
  let rec loop top =
    function
      [] -> MLast.ExUid (loc, "[]")
    | e1 :: el ->
        let loc = if top then loc else fst (MLast.loc_of_expr e1), snd loc in
        MLast.ExApp
          (loc, MLast.ExApp (loc, MLast.ExUid (loc, "::"), e1), loop false el)
  in
  loop true
;;

let mklistpat loc =
  let rec loop top =
    function
      [] -> MLast.PaUid (loc, "[]")
    | p1 :: pl ->
        let loc = if top then loc else fst (MLast.loc_of_patt p1), snd loc in
        MLast.PaApp
          (loc, MLast.PaApp (loc, MLast.PaUid (loc, "::"), p1), loop false pl)
  in
  loop true
;;

let rec expr_fa al =
  function
    MLast.ExApp (_, f, a) -> expr_fa (a :: al) f
  | f -> f, al
;;

let rec quot_expr e =
  let loc = MLast.loc_of_expr e in
  match e with
    MLast.ExUid (_, "None") ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Option")),
         MLast.ExUid (loc, "None"))
  | MLast.ExApp (_, MLast.ExUid (_, "Some"), e) ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Option")),
         MLast.ExApp (loc, MLast.ExUid (loc, "Some"), quot_expr e))
  | MLast.ExUid (_, "False") ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Bool")),
         MLast.ExUid (loc, "False"))
  | MLast.ExUid (_, "True") ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Bool")),
         MLast.ExUid (loc, "True"))
  | MLast.ExUid (_, "()") -> e
  | MLast.ExApp
      (_, MLast.ExAcc (_, MLast.ExUid (_, "Qast"), MLast.ExUid (_, "List")),
       _) ->
      e
  | MLast.ExApp
      (_, MLast.ExAcc (_, MLast.ExUid (_, "Qast"), MLast.ExUid (_, "Option")),
       _) ->
      e
  | MLast.ExApp
      (_, MLast.ExAcc (_, MLast.ExUid (_, "Qast"), MLast.ExUid (_, "Str")),
       _) ->
      e
  | MLast.ExUid (_, "[]") ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "List")),
         MLast.ExUid (loc, "[]"))
  | MLast.ExApp
      (_, MLast.ExApp (_, MLast.ExUid (_, "::"), e), MLast.ExUid (_, "[]")) ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "List")),
         MLast.ExApp
           (loc, MLast.ExApp (loc, MLast.ExUid (loc, "::"), quot_expr e),
            MLast.ExUid (loc, "[]")))
  | MLast.ExApp (_, MLast.ExApp (_, MLast.ExUid (_, "::"), e1), e2) ->
      MLast.ExApp
        (loc,
         MLast.ExApp
           (loc,
            MLast.ExAcc
              (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Cons")),
            quot_expr e1),
         quot_expr e2)
  | MLast.ExApp (_, _, _) ->
      let (f, al) = expr_fa [] e in
      begin match f with
        MLast.ExUid (_, c) ->
          let al = List.map quot_expr al in
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")),
                MLast.ExStr (loc, c)),
             mklistexp loc al)
      | MLast.ExAcc (_, _, MLast.ExUid (_, c)) ->
          let al = List.map quot_expr al in
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")),
                MLast.ExStr (loc, c)),
             mklistexp loc al)
      | MLast.ExLid (_, f) ->
          let al = List.map quot_expr al in
          List.fold_left (fun f e -> MLast.ExApp (loc, f, e))
            (MLast.ExLid (loc, f)) al
      | _ -> e
      end
  | MLast.ExRec (_, pel, None) ->
      begin try
        let lel =
          List.map
            (fun (p, e) ->
               let lab =
                 match p with
                   MLast.PaLid (_, c) -> MLast.ExStr (loc, c)
                 | MLast.PaAcc (_, _, MLast.PaLid (_, c)) ->
                     MLast.ExStr (loc, c)
                 | _ -> raise Not_found
               in
               MLast.ExTup (loc, [lab; quot_expr e]))
            pel
        in
        MLast.ExApp
          (loc,
           MLast.ExAcc
             (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Record")),
           mklistexp loc lel)
      with
        Not_found -> e
      end
  | MLast.ExLid (_, s) ->
      if s = !(Stdpp.loc_name) then
        MLast.ExAcc (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Loc"))
      else e
  | MLast.ExAcc (_, _, MLast.ExUid (_, s)) ->
      MLast.ExApp
        (loc,
         MLast.ExApp
           (loc,
            MLast.ExAcc
              (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")),
            MLast.ExStr (loc, s)),
         MLast.ExUid (loc, "[]"))
  | MLast.ExUid (_, s) ->
      MLast.ExApp
        (loc,
         MLast.ExApp
           (loc,
            MLast.ExAcc
              (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Node")),
            MLast.ExStr (loc, s)),
         MLast.ExUid (loc, "[]"))
  | MLast.ExStr (_, s) ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Str")),
         MLast.ExStr (loc, s))
  | MLast.ExTup (_, el) ->
      let el = List.map quot_expr el in
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Tuple")),
         mklistexp loc el)
  | MLast.ExLet (_, r, pel, e) ->
      let pel = List.map (fun (p, e) -> p, quot_expr e) pel in
      MLast.ExLet (loc, r, pel, quot_expr e)
  | _ -> e
;;

let symgen = "xx";;

let pname_of_ptuple pl =
  List.fold_left
    (fun pname p ->
       match p with
         MLast.PaLid (_, s) -> pname ^ s
       | _ -> pname)
    "" pl
;;

let quotify_action psl act =
  let e = quot_expr act in
  List.fold_left
    (fun e ps ->
       match ps.pattern with
         Some (MLast.PaTup (_, pl)) ->
           let loc = 0, 0 in
           let pname = pname_of_ptuple pl in
           let (pl1, el1) =
             let (l, _) =
               List.fold_left
                 (fun (l, cnt) _ ->
                    (symgen ^ string_of_int cnt) :: l, cnt + 1)
                 ([], 1) pl
             in
             let l = List.rev l in
             List.map (fun s -> MLast.PaLid (loc, s)) l,
             List.map (fun s -> MLast.ExLid (loc, s)) l
           in
           MLast.ExLet
             (loc, false,
              [MLast.PaTup (loc, pl),
               MLast.ExMat
                 (loc, MLast.ExLid (loc, pname),
                  [MLast.PaApp
                     (loc,
                      MLast.PaAcc
                        (loc, MLast.PaUid (loc, "Qast"),
                         MLast.PaUid (loc, "Tuple")),
                      mklistpat loc pl1),
                   None, MLast.ExTup (loc, el1);
                   MLast.PaAny loc, None,
                   MLast.ExMat (loc, MLast.ExUid (loc, "()"), [])])],
              e)
       | _ -> e)
    e psl
;;

let rec make_ctyp styp tvar =
  match styp with
    STlid (loc, s) -> MLast.TyLid (loc, s)
  | STapp (loc, t1, t2) ->
      MLast.TyApp (loc, make_ctyp t1 tvar, make_ctyp t2 tvar)
  | STquo (loc, s) -> MLast.TyQuo (loc, s)
  | STself (loc, x) ->
      if tvar = "" then
        Stdpp.raise_with_loc loc
          (Stream.Error ("'" ^ x ^ "' illegal in anonymous entry level"))
      else MLast.TyQuo (loc, tvar)
  | STtyp t -> t
;;

let rec make_expr gmod tvar =
  function
    TXmeta (loc, n, tl, e, t) ->
      let el =
        List.fold_right
          (fun t el ->
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc, MLast.ExUid (loc, "::"), make_expr gmod "" t),
                el))
          tl (MLast.ExUid (loc, "[]"))
      in
      MLast.ExApp
        (loc,
         MLast.ExApp
           (loc,
            MLast.ExApp
              (loc,
               MLast.ExAcc
                 (loc, MLast.ExUid (loc, "Gramext"),
                  MLast.ExUid (loc, "Smeta")),
               MLast.ExStr (loc, n)),
            el),
         MLast.ExApp
           (loc,
            MLast.ExAcc
              (loc, MLast.ExUid (loc, "Obj"), MLast.ExLid (loc, "repr")),
            MLast.ExTyc (loc, e, make_ctyp t tvar)))
  | TXlist (loc, min, t, ts) ->
      let txt = make_expr gmod "" t in
      begin match min, ts with
        false, None ->
          MLast.ExApp
            (loc,
             MLast.ExAcc
               (loc, MLast.ExUid (loc, "Gramext"),
                MLast.ExUid (loc, "Slist0")),
             txt)
      | true, None ->
          MLast.ExApp
            (loc,
             MLast.ExAcc
               (loc, MLast.ExUid (loc, "Gramext"),
                MLast.ExUid (loc, "Slist1")),
             txt)
      | false, Some s ->
          let x = make_expr gmod tvar s in
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "Gramext"),
                   MLast.ExUid (loc, "Slist0sep")),
                txt),
             x)
      | true, Some s ->
          let x = make_expr gmod tvar s in
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "Gramext"),
                   MLast.ExUid (loc, "Slist1sep")),
                txt),
             x)
      end
  | TXnext loc ->
      MLast.ExAcc
        (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Snext"))
  | TXnterm (loc, n, lev) ->
      begin match lev with
        Some lab ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc, MLast.ExUid (loc, "Gramext"),
                   MLast.ExUid (loc, "Snterml")),
                MLast.ExApp
                  (loc,
                   MLast.ExAcc
                     (loc,
                      MLast.ExAcc
                        (loc, MLast.ExUid (loc, gmod),
                         MLast.ExUid (loc, "Entry")),
                      MLast.ExLid (loc, "obj")),
                   MLast.ExTyc
                     (loc, n.expr,
                      MLast.TyApp
                        (loc,
                         MLast.TyAcc
                           (loc,
                            MLast.TyAcc
                              (loc, MLast.TyUid (loc, gmod),
                               MLast.TyUid (loc, "Entry")),
                            MLast.TyLid (loc, "e")),
                         MLast.TyQuo (loc, n.tvar))))),
             MLast.ExStr (loc, lab))
      | None ->
          if n.tvar = tvar then
            MLast.ExAcc
              (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Sself"))
          else
            MLast.ExApp
              (loc,
               MLast.ExAcc
                 (loc, MLast.ExUid (loc, "Gramext"),
                  MLast.ExUid (loc, "Snterm")),
               MLast.ExApp
                 (loc,
                  MLast.ExAcc
                    (loc,
                     MLast.ExAcc
                       (loc, MLast.ExUid (loc, gmod),
                        MLast.ExUid (loc, "Entry")),
                     MLast.ExLid (loc, "obj")),
                  MLast.ExTyc
                    (loc, n.expr,
                     MLast.TyApp
                       (loc,
                        MLast.TyAcc
                          (loc,
                           MLast.TyAcc
                             (loc, MLast.TyUid (loc, gmod),
                              MLast.TyUid (loc, "Entry")),
                           MLast.TyLid (loc, "e")),
                        MLast.TyQuo (loc, n.tvar)))))
      end
  | TXopt (loc, t) ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Sopt")),
         make_expr gmod "" t)
  | TXrules (loc, rl) ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Gramext"), MLast.ExLid (loc, "srules")),
         make_expr_rules loc gmod rl "")
  | TXself loc ->
      MLast.ExAcc
        (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Sself"))
  | TXtok (loc, s, e) ->
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Stoken")),
         MLast.ExTup (loc, [MLast.ExStr (loc, s); e]))
and make_expr_rules loc gmod rl tvar =
  List.fold_left
    (fun txt (sl, ac) ->
       let sl =
         List.fold_right
           (fun t txt ->
              let x = make_expr gmod tvar t in
              MLast.ExApp
                (loc, MLast.ExApp (loc, MLast.ExUid (loc, "::"), x), txt))
           sl (MLast.ExUid (loc, "[]"))
       in
       MLast.ExApp
         (loc,
          MLast.ExApp
            (loc, MLast.ExUid (loc, "::"), MLast.ExTup (loc, [sl; ac])),
          txt))
    (MLast.ExUid (loc, "[]")) rl
;;

let text_of_action loc psl rtvar act tvar =
  let locid = MLast.PaLid (loc, !(Stdpp.loc_name)) in
  let act =
    match act with
      Some act -> if !quotify then quotify_action psl act else act
    | None -> MLast.ExUid (loc, "()")
  in
  let e =
    MLast.ExFun
      (loc,
       [MLast.PaTyc
          (loc, locid,
           MLast.TyTup
             (loc, [MLast.TyLid (loc, "int"); MLast.TyLid (loc, "int")])),
        None, MLast.ExTyc (loc, act, MLast.TyQuo (loc, rtvar))])
  in
  let txt =
    List.fold_left
      (fun txt ps ->
         match ps.pattern with
           None -> MLast.ExFun (loc, [MLast.PaAny loc, None, txt])
         | Some p ->
             let t = make_ctyp ps.symbol.styp tvar in
             let p =
               match p with
                 MLast.PaTup (_, pl) when !quotify ->
                   MLast.PaLid (loc, pname_of_ptuple pl)
               | _ -> p
             in
             MLast.ExFun (loc, [MLast.PaTyc (loc, p, t), None, txt]))
      e psl
  in
  let txt =
    if !meta_action then
      MLast.ExApp
        (loc,
         MLast.ExAcc
           (loc, MLast.ExUid (loc, "Obj"), MLast.ExLid (loc, "magic")),
         MetaAction.mexpr txt)
    else txt
  in
  MLast.ExApp
    (loc,
     MLast.ExAcc
       (loc, MLast.ExUid (loc, "Gramext"), MLast.ExLid (loc, "action")),
     txt)
;;

let srules loc t rl tvar =
  List.map
    (fun r ->
       let sl = List.map (fun ps -> ps.symbol.text) r.prod in
       let ac = text_of_action loc r.prod t r.action tvar in sl, ac)
    rl
;;

let expr_of_delete_rule loc gmod n sl =
  let sl =
    List.fold_right
      (fun s e ->
         MLast.ExApp
           (loc,
            MLast.ExApp
              (loc, MLast.ExUid (loc, "::"), make_expr gmod "" s.text),
            e))
      sl (MLast.ExUid (loc, "[]"))
  in
  n.expr, sl
;;

let rec ident_of_expr =
  function
    MLast.ExLid (_, s) -> s
  | MLast.ExUid (_, s) -> s
  | MLast.ExAcc (_, e1, e2) -> ident_of_expr e1 ^ "__" ^ ident_of_expr e2
  | _ -> failwith "internal error in pa_extend"
;;

let mk_name loc e = {expr = e; tvar = ident_of_expr e; loc = loc};;

let slist loc min sep symb =
  let t =
    match sep with
      Some s -> Some s.text
    | None -> None
  in
  TXlist (loc, min, symb.text, t)
;;

let sstoken loc s =
  let n = mk_name loc (MLast.ExLid (loc, ("a_" ^ s))) in
  TXnterm (loc, n, None)
;;

let mk_psymbol p s t =
  let symb = {used = []; text = s; styp = t} in
  {pattern = Some p; symbol = symb}
;;

let sslist loc min sep s =
  let rl =
    let r1 =
      let prod =
        let n = mk_name loc (MLast.ExLid (loc, "a_list")) in
        [mk_psymbol (MLast.PaLid (loc, "a")) (TXnterm (loc, n, None))
           (STquo (loc, "a_list"))]
      in
      let act = MLast.ExLid (loc, "a") in {prod = prod; action = Some act}
    in
    let r2 =
      let prod =
        [mk_psymbol (MLast.PaLid (loc, "a")) (slist loc min sep s)
           (STapp (loc, STlid (loc, "list"), s.styp))]
      in
      let act =
        MLast.ExApp
          (loc,
           MLast.ExAcc
             (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "List")),
           MLast.ExLid (loc, "a"))
      in
      {prod = prod; action = Some act}
    in
    [r1; r2]
  in
  let used =
    match sep with
      Some symb -> symb.used @ s.used
    | None -> s.used
  in
  let used = "a_list" :: used in
  let text = TXrules (loc, srules loc "a_list" rl "") in
  let styp = STquo (loc, "a_list") in {used = used; text = text; styp = styp}
;;

let ssopt loc s =
  let rl =
    let r1 =
      let prod =
        let n = mk_name loc (MLast.ExLid (loc, "a_opt")) in
        [mk_psymbol (MLast.PaLid (loc, "a")) (TXnterm (loc, n, None))
           (STquo (loc, "a_opt"))]
      in
      let act = MLast.ExLid (loc, "a") in {prod = prod; action = Some act}
    in
    let r2 =
      let s =
        match s.text with
          TXtok (loc, "", MLast.ExStr (_, _)) ->
            let rl =
              [{prod =
                  [{pattern = Some (MLast.PaLid (loc, "x")); symbol = s}];
                action =
                  Some
                    (MLast.ExApp
                       (loc,
                        MLast.ExAcc
                          (loc, MLast.ExUid (loc, "Qast"),
                           MLast.ExUid (loc, "Str")),
                        MLast.ExLid (loc, "x")))}]
            in
            let t = new_type_var () in
            {used = []; text = TXrules (loc, srules loc t rl "");
             styp = STquo (loc, t)}
        | _ -> s
      in
      let prod =
        [mk_psymbol (MLast.PaLid (loc, "a")) (TXopt (loc, s.text))
           (STapp (loc, STlid (loc, "option"), s.styp))]
      in
      let act =
        MLast.ExApp
          (loc,
           MLast.ExAcc
             (loc, MLast.ExUid (loc, "Qast"), MLast.ExUid (loc, "Option")),
           MLast.ExLid (loc, "a"))
      in
      {prod = prod; action = Some act}
    in
    [r1; r2]
  in
  let used = "a_opt" :: s.used in
  let text = TXrules (loc, srules loc "a_opt" rl "") in
  let styp = STquo (loc, "a_opt") in {used = used; text = text; styp = styp}
;;

let text_of_entry loc gmod e =
  let ent =
    let x = e.name in
    let loc = e.name.loc in
    MLast.ExTyc
      (loc, x.expr,
       MLast.TyApp
         (loc,
          MLast.TyAcc
            (loc,
             MLast.TyAcc
               (loc, MLast.TyUid (loc, gmod), MLast.TyUid (loc, "Entry")),
             MLast.TyLid (loc, "e")),
          MLast.TyQuo (loc, x.tvar)))
  in
  let pos =
    match e.pos with
      Some pos -> MLast.ExApp (loc, MLast.ExUid (loc, "Some"), pos)
    | None -> MLast.ExUid (loc, "None")
  in
  let txt =
    List.fold_right
      (fun level txt ->
         let lab =
           match level.label with
             Some lab ->
               MLast.ExApp
                 (loc, MLast.ExUid (loc, "Some"), MLast.ExStr (loc, lab))
           | None -> MLast.ExUid (loc, "None")
         in
         let ass =
           match level.assoc with
             Some ass -> MLast.ExApp (loc, MLast.ExUid (loc, "Some"), ass)
           | None -> MLast.ExUid (loc, "None")
         in
         let txt =
           let rl = srules loc e.name.tvar level.rules e.name.tvar in
           let e = make_expr_rules loc gmod rl e.name.tvar in
           MLast.ExApp
             (loc,
              MLast.ExApp
                (loc, MLast.ExUid (loc, "::"),
                 MLast.ExTup (loc, [lab; ass; e])),
              txt)
         in
         txt)
      e.levels (MLast.ExUid (loc, "[]"))
  in
  ent, pos, txt
;;

let let_in_of_extend loc gmod functor_version gl el args =
  match gl with
    Some (n1 :: _ as nl) ->
      check_use nl el;
      let ll =
        let same_tvar e n = e.name.tvar = n.tvar in
        List.fold_right
          (fun e ll ->
             match e.name.expr with
               MLast.ExLid (_, _) ->
                 if List.exists (same_tvar e) nl then ll
                 else if List.exists (same_tvar e) ll then ll
                 else e.name :: ll
             | _ -> ll)
          el []
      in
      let globals =
        List.map
          (fun {expr = e; tvar = x; loc = loc} ->
             MLast.PaAny loc,
             MLast.ExTyc
               (loc, e,
                MLast.TyApp
                  (loc,
                   MLast.TyAcc
                     (loc,
                      MLast.TyAcc
                        (loc, MLast.TyUid (loc, gmod),
                         MLast.TyUid (loc, "Entry")),
                      MLast.TyLid (loc, "e")),
                   MLast.TyQuo (loc, x))))
          nl
      in
      let locals =
        List.map
          (fun {expr = e; tvar = x; loc = loc} ->
             let i =
               match e with
                 MLast.ExLid (_, i) -> i
               | _ -> failwith "internal error in pa_extend"
             in
             MLast.PaLid (loc, i),
             MLast.ExTyc
               (loc,
                MLast.ExApp
                  (loc, MLast.ExLid (loc, "grammar_entry_create"),
                   MLast.ExStr (loc, i)),
                MLast.TyApp
                  (loc,
                   MLast.TyAcc
                     (loc,
                      MLast.TyAcc
                        (loc, MLast.TyUid (loc, gmod),
                         MLast.TyUid (loc, "Entry")),
                      MLast.TyLid (loc, "e")),
                   MLast.TyQuo (loc, x))))
          ll
      in
      let e =
        if ll = [] then args
        else if functor_version then
          MLast.ExLet
            (loc, false,
             [MLast.PaLid (loc, "grammar_entry_create"),
              MLast.ExAcc
                (loc,
                 MLast.ExAcc
                   (loc, MLast.ExUid (loc, gmod), MLast.ExUid (loc, "Entry")),
                 MLast.ExLid (loc, "create"))],
             MLast.ExLet (loc, false, locals, args))
        else
          MLast.ExLet
            (loc, false,
             [MLast.PaLid (loc, "grammar_entry_create"),
              MLast.ExFun
                (loc,
                 [MLast.PaLid (loc, "s"), None,
                  MLast.ExApp
                    (loc,
                     MLast.ExApp
                       (loc,
                        MLast.ExAcc
                          (loc,
                           MLast.ExAcc
                             (loc, MLast.ExUid (loc, gmod),
                              MLast.ExUid (loc, "Entry")),
                           MLast.ExLid (loc, "create")),
                        MLast.ExApp
                          (loc,
                           MLast.ExAcc
                             (loc, MLast.ExUid (loc, gmod),
                              MLast.ExLid (loc, "of_entry")),
                           locate n1)),
                     MLast.ExLid (loc, "s"))])],
             MLast.ExLet (loc, false, locals, args))
      in
      MLast.ExLet (loc, false, globals, e)
  | _ -> args
;;

let text_of_extend loc gmod gl el f =
  if !split_ext then
    let args =
      List.map
        (fun e ->
           let (ent, pos, txt) = text_of_entry e.name.loc gmod e in
           let ent =
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, gmod),
                      MLast.ExUid (loc, "Entry")),
                   MLast.ExLid (loc, "obj")),
                ent)
           in
           let e = MLast.ExTup (loc, [ent; pos; txt]) in
           MLast.ExLet
             (loc, false,
              [MLast.PaLid (loc, "aux"),
               MLast.ExFun
                 (loc,
                  [MLast.PaUid (loc, "()"), None,
                   MLast.ExApp
                     (loc, f,
                      MLast.ExApp
                        (loc, MLast.ExApp (loc, MLast.ExUid (loc, "::"), e),
                         MLast.ExUid (loc, "[]")))])],
              MLast.ExApp
                (loc, MLast.ExLid (loc, "aux"), MLast.ExUid (loc, "()"))))
        el
    in
    let args = MLast.ExSeq (loc, args) in
    let_in_of_extend loc gmod false gl el args
  else
    let args =
      List.fold_right
        (fun e el ->
           let (ent, pos, txt) = text_of_entry e.name.loc gmod e in
           let ent =
             MLast.ExApp
               (loc,
                MLast.ExAcc
                  (loc,
                   MLast.ExAcc
                     (loc, MLast.ExUid (loc, gmod),
                      MLast.ExUid (loc, "Entry")),
                   MLast.ExLid (loc, "obj")),
                ent)
           in
           let e = MLast.ExTup (loc, [ent; pos; txt]) in
           MLast.ExApp
             (loc, MLast.ExApp (loc, MLast.ExUid (loc, "::"), e), el))
        el (MLast.ExUid (loc, "[]"))
    in
    let args = let_in_of_extend loc gmod false gl el args in
    MLast.ExApp (loc, f, args)
;;

let text_of_functorial_extend loc gmod gl el =
  let args =
    let el =
      List.map
        (fun e ->
           let (ent, pos, txt) = text_of_entry e.name.loc gmod e in
           let e =
             MLast.ExApp
               (loc,
                MLast.ExApp
                  (loc,
                   MLast.ExApp
                     (loc,
                      MLast.ExAcc
                        (loc, MLast.ExUid (loc, gmod),
                         MLast.ExLid (loc, "extend")),
                      ent),
                   pos),
                txt)
           in
           if !split_ext then
             MLast.ExLet
               (loc, false,
                [MLast.PaLid (loc, "aux"),
                 MLast.ExFun (loc, [MLast.PaUid (loc, "()"), None, e])],
                MLast.ExApp
                  (loc, MLast.ExLid (loc, "aux"), MLast.ExUid (loc, "()")))
           else e)
        el
    in
    MLast.ExSeq (loc, el)
  in
  let_in_of_extend loc gmod true gl el args
;;

open Pcaml;;
let symbol = Grammar.Entry.create gram "symbol";;

Grammar.extend
  (let _ = (expr : 'expr Grammar.Entry.e)
   and _ = (symbol : 'symbol Grammar.Entry.e) in
   let grammar_entry_create s =
     Grammar.Entry.create (Grammar.of_entry expr) s
   in
   let extend_body : 'extend_body Grammar.Entry.e =
     grammar_entry_create "extend_body"
   and gextend_body : 'gextend_body Grammar.Entry.e =
     grammar_entry_create "gextend_body"
   and delete_rule_body : 'delete_rule_body Grammar.Entry.e =
     grammar_entry_create "delete_rule_body"
   and gdelete_rule_body : 'gdelete_rule_body Grammar.Entry.e =
     grammar_entry_create "gdelete_rule_body"
   and efunction : 'efunction Grammar.Entry.e =
     grammar_entry_create "efunction"
   and global : 'global Grammar.Entry.e = grammar_entry_create "global"
   and entry : 'entry Grammar.Entry.e = grammar_entry_create "entry"
   and position : 'position Grammar.Entry.e = grammar_entry_create "position"
   and level_list : 'level_list Grammar.Entry.e =
     grammar_entry_create "level_list"
   and level : 'level Grammar.Entry.e = grammar_entry_create "level"
   and assoc : 'assoc Grammar.Entry.e = grammar_entry_create "assoc"
   and rule_list : 'rule_list Grammar.Entry.e =
     grammar_entry_create "rule_list"
   and rule : 'rule Grammar.Entry.e = grammar_entry_create "rule"
   and psymbol : 'psymbol Grammar.Entry.e = grammar_entry_create "psymbol"
   and pattern : 'pattern Grammar.Entry.e = grammar_entry_create "pattern"
   and patterns_comma : 'patterns_comma Grammar.Entry.e =
     grammar_entry_create "patterns_comma"
   and name : 'name Grammar.Entry.e = grammar_entry_create "name"
   and qualid : 'qualid Grammar.Entry.e = grammar_entry_create "qualid"
   and string : 'string Grammar.Entry.e = grammar_entry_create "string" in
   [Grammar.Entry.obj (expr : 'expr Grammar.Entry.e),
    Some (Gramext.After "top"),
    [None, None,
     [[Gramext.Stoken ("", "GDELETE_RULE");
       Gramext.Snterm
         (Grammar.Entry.obj
            (gdelete_rule_body : 'gdelete_rule_body Grammar.Entry.e));
       Gramext.Stoken ("", "END")],
      Gramext.action
        (fun _ (e : 'gdelete_rule_body) _ (loc : int * int) -> (e : 'expr));
      [Gramext.Stoken ("", "DELETE_RULE");
       Gramext.Snterm
         (Grammar.Entry.obj
            (delete_rule_body : 'delete_rule_body Grammar.Entry.e));
       Gramext.Stoken ("", "END")],
      Gramext.action
        (fun _ (e : 'delete_rule_body) _ (loc : int * int) -> (e : 'expr));
      [Gramext.Stoken ("", "GEXTEND");
       Gramext.Snterm
         (Grammar.Entry.obj (gextend_body : 'gextend_body Grammar.Entry.e));
       Gramext.Stoken ("", "END")],
      Gramext.action
        (fun _ (e : 'gextend_body) _ (loc : int * int) -> (e : 'expr));
      [Gramext.Stoken ("", "EXTEND");
       Gramext.Snterm
         (Grammar.Entry.obj (extend_body : 'extend_body Grammar.Entry.e));
       Gramext.Stoken ("", "END")],
      Gramext.action
        (fun _ (e : 'extend_body) _ (loc : int * int) -> (e : 'expr))]];
    Grammar.Entry.obj (extend_body : 'extend_body Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Snterm
         (Grammar.Entry.obj (efunction : 'efunction Grammar.Entry.e));
       Gramext.Sopt
         (Gramext.Snterm
            (Grammar.Entry.obj (global : 'global Grammar.Entry.e)));
       Gramext.Slist1
         (Gramext.srules
            [[Gramext.Snterm
                (Grammar.Entry.obj (entry : 'entry Grammar.Entry.e));
              Gramext.Stoken ("", ";")],
             Gramext.action
               (fun _ (e : 'entry) (loc : int * int) -> (e : 'e__1))])],
      Gramext.action
        (fun (el : 'e__1 list) (sl : 'global option) (f : 'efunction)
           (loc : int * int) ->
           (text_of_extend loc "Grammar" sl el f : 'extend_body))]];
    Grammar.Entry.obj (gextend_body : 'gextend_body Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("UIDENT", "");
       Gramext.Sopt
         (Gramext.Snterm
            (Grammar.Entry.obj (global : 'global Grammar.Entry.e)));
       Gramext.Slist1
         (Gramext.srules
            [[Gramext.Snterm
                (Grammar.Entry.obj (entry : 'entry Grammar.Entry.e));
              Gramext.Stoken ("", ";")],
             Gramext.action
               (fun _ (e : 'entry) (loc : int * int) -> (e : 'e__2))])],
      Gramext.action
        (fun (el : 'e__2 list) (sl : 'global option) (g : string)
           (loc : int * int) ->
           (text_of_functorial_extend loc g sl el : 'gextend_body))]];
    Grammar.Entry.obj (delete_rule_body : 'delete_rule_body Grammar.Entry.e),
    None,
    [None, None,
     [[Gramext.Snterm (Grammar.Entry.obj (name : 'name Grammar.Entry.e));
       Gramext.Stoken ("", ":");
       Gramext.Slist1sep
         (Gramext.Snterm
            (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e)),
          Gramext.Stoken ("", ";"))],
      Gramext.action
        (fun (sl : 'symbol list) _ (n : 'name) (loc : int * int) ->
           (let (e, b) = expr_of_delete_rule loc "Grammar" n sl in
            MLast.ExApp
              (loc,
               MLast.ExApp
                 (loc,
                  MLast.ExAcc
                    (loc, MLast.ExUid (loc, "Grammar"),
                     MLast.ExLid (loc, "delete_rule")),
                  e),
               b) :
            'delete_rule_body))]];
    Grammar.Entry.obj
      (gdelete_rule_body : 'gdelete_rule_body Grammar.Entry.e),
    None,
    [None, None,
     [[Gramext.Stoken ("UIDENT", "");
       Gramext.Snterm (Grammar.Entry.obj (name : 'name Grammar.Entry.e));
       Gramext.Stoken ("", ":");
       Gramext.Slist1sep
         (Gramext.Snterm
            (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e)),
          Gramext.Stoken ("", ";"))],
      Gramext.action
        (fun (sl : 'symbol list) _ (n : 'name) (g : string)
           (loc : int * int) ->
           (let (e, b) = expr_of_delete_rule loc g n sl in
            MLast.ExApp
              (loc,
               MLast.ExApp
                 (loc,
                  MLast.ExAcc
                    (loc, MLast.ExUid (loc, g),
                     MLast.ExLid (loc, "delete_rule")),
                  e),
               b) :
            'gdelete_rule_body))]];
    Grammar.Entry.obj (efunction : 'efunction Grammar.Entry.e), None,
    [None, None,
     [[],
      Gramext.action
        (fun (loc : int * int) ->
           (MLast.ExAcc
              (loc, MLast.ExUid (loc, "Grammar"),
               MLast.ExLid (loc, "extend")) :
            'efunction));
      [Gramext.Stoken ("UIDENT", "FUNCTION"); Gramext.Stoken ("", ":");
       Gramext.Snterm (Grammar.Entry.obj (qualid : 'qualid Grammar.Entry.e));
       Gramext.Stoken ("", ";")],
      Gramext.action
        (fun _ (f : 'qualid) _ _ (loc : int * int) -> (f : 'efunction))]];
    Grammar.Entry.obj (global : 'global Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("UIDENT", "GLOBAL"); Gramext.Stoken ("", ":");
       Gramext.Slist1
         (Gramext.Snterm (Grammar.Entry.obj (name : 'name Grammar.Entry.e)));
       Gramext.Stoken ("", ";")],
      Gramext.action
        (fun _ (sl : 'name list) _ _ (loc : int * int) -> (sl : 'global))]];
    Grammar.Entry.obj (entry : 'entry Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Snterm (Grammar.Entry.obj (name : 'name Grammar.Entry.e));
       Gramext.Stoken ("", ":");
       Gramext.Sopt
         (Gramext.Snterm
            (Grammar.Entry.obj (position : 'position Grammar.Entry.e)));
       Gramext.Snterm
         (Grammar.Entry.obj (level_list : 'level_list Grammar.Entry.e))],
      Gramext.action
        (fun (ll : 'level_list) (pos : 'position option) _ (n : 'name)
           (loc : int * int) ->
           ({name = n; pos = pos; levels = ll} : 'entry))]];
    Grammar.Entry.obj (position : 'position Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("UIDENT", "LEVEL");
       Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
      Gramext.action
        (fun (n : 'string) _ (loc : int * int) ->
           (MLast.ExApp
              (loc,
               MLast.ExAcc
                 (loc, MLast.ExUid (loc, "Gramext"),
                  MLast.ExUid (loc, "Level")),
               n) :
            'position));
      [Gramext.Stoken ("UIDENT", "AFTER");
       Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
      Gramext.action
        (fun (n : 'string) _ (loc : int * int) ->
           (MLast.ExApp
              (loc,
               MLast.ExAcc
                 (loc, MLast.ExUid (loc, "Gramext"),
                  MLast.ExUid (loc, "After")),
               n) :
            'position));
      [Gramext.Stoken ("UIDENT", "BEFORE");
       Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
      Gramext.action
        (fun (n : 'string) _ (loc : int * int) ->
           (MLast.ExApp
              (loc,
               MLast.ExAcc
                 (loc, MLast.ExUid (loc, "Gramext"),
                  MLast.ExUid (loc, "Before")),
               n) :
            'position));
      [Gramext.Stoken ("UIDENT", "LAST")],
      Gramext.action
        (fun _ (loc : int * int) ->
           (MLast.ExAcc
              (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Last")) :
            'position));
      [Gramext.Stoken ("UIDENT", "FIRST")],
      Gramext.action
        (fun _ (loc : int * int) ->
           (MLast.ExAcc
              (loc, MLast.ExUid (loc, "Gramext"),
               MLast.ExUid (loc, "First")) :
            'position))]];
    Grammar.Entry.obj (level_list : 'level_list Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("", "[");
       Gramext.Slist0sep
         (Gramext.Snterm (Grammar.Entry.obj (level : 'level Grammar.Entry.e)),
          Gramext.Stoken ("", "|"));
       Gramext.Stoken ("", "]")],
      Gramext.action
        (fun _ (ll : 'level list) _ (loc : int * int) ->
           (ll : 'level_list))]];
    Grammar.Entry.obj (level : 'level Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Sopt (Gramext.Stoken ("STRING", ""));
       Gramext.Sopt
         (Gramext.Snterm
            (Grammar.Entry.obj (assoc : 'assoc Grammar.Entry.e)));
       Gramext.Snterm
         (Grammar.Entry.obj (rule_list : 'rule_list Grammar.Entry.e))],
      Gramext.action
        (fun (rules : 'rule_list) (ass : 'assoc option) (lab : string option)
           (loc : int * int) ->
           ({label = lab; assoc = ass; rules = rules} : 'level))]];
    Grammar.Entry.obj (assoc : 'assoc Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("UIDENT", "NONA")],
      Gramext.action
        (fun _ (loc : int * int) ->
           (MLast.ExAcc
              (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "NonA")) :
            'assoc));
      [Gramext.Stoken ("UIDENT", "RIGHTA")],
      Gramext.action
        (fun _ (loc : int * int) ->
           (MLast.ExAcc
              (loc, MLast.ExUid (loc, "Gramext"),
               MLast.ExUid (loc, "RightA")) :
            'assoc));
      [Gramext.Stoken ("UIDENT", "LEFTA")],
      Gramext.action
        (fun _ (loc : int * int) ->
           (MLast.ExAcc
              (loc, MLast.ExUid (loc, "Gramext"),
               MLast.ExUid (loc, "LeftA")) :
            'assoc))]];
    Grammar.Entry.obj (rule_list : 'rule_list Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("", "[");
       Gramext.Slist1sep
         (Gramext.Snterm (Grammar.Entry.obj (rule : 'rule Grammar.Entry.e)),
          Gramext.Stoken ("", "|"));
       Gramext.Stoken ("", "]")],
      Gramext.action
        (fun _ (rules : 'rule list) _ (loc : int * int) ->
           (retype_rule_list_without_patterns loc rules : 'rule_list));
      [Gramext.Stoken ("", "["); Gramext.Stoken ("", "]")],
      Gramext.action (fun _ _ (loc : int * int) -> ([] : 'rule_list))]];
    Grammar.Entry.obj (rule : 'rule Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Slist0sep
         (Gramext.Snterm
            (Grammar.Entry.obj (psymbol : 'psymbol Grammar.Entry.e)),
          Gramext.Stoken ("", ";"))],
      Gramext.action
        (fun (psl : 'psymbol list) (loc : int * int) ->
           ({prod = psl; action = None} : 'rule));
      [Gramext.Slist0sep
         (Gramext.Snterm
            (Grammar.Entry.obj (psymbol : 'psymbol Grammar.Entry.e)),
          Gramext.Stoken ("", ";"));
       Gramext.Stoken ("", "->");
       Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
      Gramext.action
        (fun (act : 'expr) _ (psl : 'psymbol list) (loc : int * int) ->
           ({prod = psl; action = Some act} : 'rule))]];
    Grammar.Entry.obj (psymbol : 'psymbol Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Snterm (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
      Gramext.action
        (fun (s : 'symbol) (loc : int * int) ->
           ({pattern = None; symbol = s} : 'psymbol));
      [Gramext.Snterm
         (Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e));
       Gramext.Stoken ("", "=");
       Gramext.Snterm (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
      Gramext.action
        (fun (s : 'symbol) _ (p : 'pattern) (loc : int * int) ->
           ({pattern = Some p; symbol = s} : 'psymbol));
      [Gramext.Stoken ("LIDENT", "");
       Gramext.Sopt
         (Gramext.srules
            [[Gramext.Stoken ("UIDENT", "LEVEL");
              Gramext.Stoken ("STRING", "")],
             Gramext.action
               (fun (s : string) _ (loc : int * int) -> (s : 'e__3))])],
      Gramext.action
        (fun (lev : 'e__3 option) (i : string) (loc : int * int) ->
           (let name = mk_name loc (MLast.ExLid (loc, i)) in
            let text = TXnterm (loc, name, lev) in
            let styp = STquo (loc, i) in
            let symb = {used = [i]; text = text; styp = styp} in
            {pattern = None; symbol = symb} :
            'psymbol));
      [Gramext.Stoken ("LIDENT", ""); Gramext.Stoken ("", "=");
       Gramext.Snterm (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
      Gramext.action
        (fun (s : 'symbol) _ (p : string) (loc : int * int) ->
           ({pattern = Some (MLast.PaLid (loc, p)); symbol = s} :
            'psymbol))]];
    Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e), None,
    [Some "top", Some Gramext.NonA,
     [[Gramext.Stoken ("UIDENT", "OPT"); Gramext.Sself],
      Gramext.action
        (fun (s : 'symbol) _ (loc : int * int) ->
           (if !quotify then ssopt loc s
            else
              let styp = STapp (loc, STlid (loc, "option"), s.styp) in
              let text = TXopt (loc, s.text) in
              {used = s.used; text = text; styp = styp} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "LIST1"); Gramext.Sself;
       Gramext.Sopt
         (Gramext.srules
            [[Gramext.Stoken ("UIDENT", "SEP");
              Gramext.Snterm
                (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
             Gramext.action
               (fun (t : 'symbol) _ (loc : int * int) -> (t : 'e__5))])],
      Gramext.action
        (fun (sep : 'e__5 option) (s : 'symbol) _ (loc : int * int) ->
           (if !quotify then sslist loc true sep s
            else
              let used =
                match sep with
                  Some symb -> symb.used @ s.used
                | None -> s.used
              in
              let styp = STapp (loc, STlid (loc, "list"), s.styp) in
              let text = slist loc true sep s in
              {used = used; text = text; styp = styp} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "LIST0"); Gramext.Sself;
       Gramext.Sopt
         (Gramext.srules
            [[Gramext.Stoken ("UIDENT", "SEP");
              Gramext.Snterm
                (Grammar.Entry.obj (symbol : 'symbol Grammar.Entry.e))],
             Gramext.action
               (fun (t : 'symbol) _ (loc : int * int) -> (t : 'e__4))])],
      Gramext.action
        (fun (sep : 'e__4 option) (s : 'symbol) _ (loc : int * int) ->
           (if !quotify then sslist loc false sep s
            else
              let used =
                match sep with
                  Some symb -> symb.used @ s.used
                | None -> s.used
              in
              let styp = STapp (loc, STlid (loc, "list"), s.styp) in
              let text = slist loc false sep s in
              {used = used; text = text; styp = styp} :
            'symbol))];
     None, None,
     [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
      Gramext.action
        (fun _ (s_t : 'symbol) _ (loc : int * int) -> (s_t : 'symbol));
      [Gramext.Snterm (Grammar.Entry.obj (name : 'name Grammar.Entry.e));
       Gramext.Sopt
         (Gramext.srules
            [[Gramext.Stoken ("UIDENT", "LEVEL");
              Gramext.Stoken ("STRING", "")],
             Gramext.action
               (fun (s : string) _ (loc : int * int) -> (s : 'e__7))])],
      Gramext.action
        (fun (lev : 'e__7 option) (n : 'name) (loc : int * int) ->
           ({used = [n.tvar]; text = TXnterm (loc, n, lev);
             styp = STquo (loc, n.tvar)} :
            'symbol));
      [Gramext.Stoken ("UIDENT", ""); Gramext.Stoken ("", ".");
       Gramext.Snterm (Grammar.Entry.obj (qualid : 'qualid Grammar.Entry.e));
       Gramext.Sopt
         (Gramext.srules
            [[Gramext.Stoken ("UIDENT", "LEVEL");
              Gramext.Stoken ("STRING", "")],
             Gramext.action
               (fun (s : string) _ (loc : int * int) -> (s : 'e__6))])],
      Gramext.action
        (fun (lev : 'e__6 option) (e : 'qualid) _ (i : string)
           (loc : int * int) ->
           (let n =
              mk_name loc (MLast.ExAcc (loc, MLast.ExUid (loc, i), e))
            in
            {used = [n.tvar]; text = TXnterm (loc, n, lev);
             styp = STquo (loc, n.tvar)} :
            'symbol));
      [Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
      Gramext.action
        (fun (e : 'string) (loc : int * int) ->
           (let text = TXtok (loc, "", e) in
            {used = []; text = text; styp = STlid (loc, "string")} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "");
       Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
      Gramext.action
        (fun (e : 'string) (x : string) (loc : int * int) ->
           (let text = TXtok (loc, x, e) in
            {used = []; text = text; styp = STlid (loc, "string")} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "")],
      Gramext.action
        (fun (x : string) (loc : int * int) ->
           (let text =
              if !quotify then sstoken loc x
              else TXtok (loc, x, MLast.ExStr (loc, ""))
            in
            {used = []; text = text; styp = STlid (loc, "string")} :
            'symbol));
      [Gramext.Stoken ("", "[");
       Gramext.Slist0sep
         (Gramext.Snterm (Grammar.Entry.obj (rule : 'rule Grammar.Entry.e)),
          Gramext.Stoken ("", "|"));
       Gramext.Stoken ("", "]")],
      Gramext.action
        (fun _ (rl : 'rule list) _ (loc : int * int) ->
           (let rl = retype_rule_list_without_patterns loc rl in
            let t = new_type_var () in
            {used = used_of_rule_list rl;
             text = TXrules (loc, srules loc t rl "");
             styp = STquo (loc, t)} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "NEXT")],
      Gramext.action
        (fun _ (loc : int * int) ->
           ({used = []; text = TXnext loc; styp = STself (loc, "NEXT")} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "SELF")],
      Gramext.action
        (fun _ (loc : int * int) ->
           ({used = []; text = TXself loc; styp = STself (loc, "SELF")} :
            'symbol))]];
    Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ",");
       Gramext.Snterm
         (Grammar.Entry.obj
            (patterns_comma : 'patterns_comma Grammar.Entry.e));
       Gramext.Stoken ("", ")")],
      Gramext.action
        (fun _ (pl : 'patterns_comma) _ (p : 'pattern) _ (loc : int * int) ->
           (MLast.PaTup (loc, (p :: pl)) : 'pattern));
      [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
      Gramext.action
        (fun _ (p : 'pattern) _ (loc : int * int) -> (p : 'pattern));
      [Gramext.Stoken ("", "_")],
      Gramext.action
        (fun _ (loc : int * int) -> (MLast.PaAny loc : 'pattern));
      [Gramext.Stoken ("LIDENT", "")],
      Gramext.action
        (fun (i : string) (loc : int * int) ->
           (MLast.PaLid (loc, i) : 'pattern))]];
    Grammar.Entry.obj (patterns_comma : 'patterns_comma Grammar.Entry.e),
    None,
    [None, None,
     [[Gramext.Sself; Gramext.Stoken ("", ",");
       Gramext.Snterm
         (Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e))],
      Gramext.action
        (fun (p : 'pattern) _ (pl : 'patterns_comma) (loc : int * int) ->
           (pl @ [p] : 'patterns_comma))];
     None, None,
     [[Gramext.Snterm
         (Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e))],
      Gramext.action
        (fun (p : 'pattern) (loc : int * int) -> ([p] : 'patterns_comma))]];
    Grammar.Entry.obj (name : 'name Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Snterm (Grammar.Entry.obj (qualid : 'qualid Grammar.Entry.e))],
      Gramext.action
        (fun (e : 'qualid) (loc : int * int) -> (mk_name loc e : 'name))]];
    Grammar.Entry.obj (qualid : 'qualid Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Sself; Gramext.Stoken ("", "."); Gramext.Sself],
      Gramext.action
        (fun (e2 : 'qualid) _ (e1 : 'qualid) (loc : int * int) ->
           (MLast.ExAcc (loc, e1, e2) : 'qualid))];
     None, None,
     [[Gramext.Stoken ("LIDENT", "")],
      Gramext.action
        (fun (i : string) (loc : int * int) ->
           (MLast.ExLid (loc, i) : 'qualid));
      [Gramext.Stoken ("UIDENT", "")],
      Gramext.action
        (fun (i : string) (loc : int * int) ->
           (MLast.ExUid (loc, i) : 'qualid))]];
    Grammar.Entry.obj (string : 'string Grammar.Entry.e), None,
    [None, None,
     [[Gramext.Stoken ("ANTIQUOT", "")],
      Gramext.action
        (fun (i : string) (loc : int * int) ->
           (let shift = fst loc + String.length "$" in
            let e =
              try Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string i) with
                Exc_located ((bp, ep), exc) ->
                  raise_with_loc (shift + bp, shift + ep) exc
            in
            Pcaml.expr_reloc (fun (bp, ep) -> shift + bp, shift + ep) 0 e :
            'string));
      [Gramext.Stoken ("STRING", "")],
      Gramext.action
        (fun (s : string) (loc : int * int) ->
           (MLast.ExStr (loc, s) : 'string))]]]);;

Pcaml.add_option "-quotify" (Arg.Set quotify) "Generate code for quotations";;

Pcaml.add_option "-meta_action" (Arg.Set meta_action) "Undocumented";;
