(* 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 = Lexing.position * Lexing.position;;

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

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 =
      let nowhere =
        {(Lexing.dummy_pos) with Lexing.pos_lnum = 1; Lexing.pos_cnum = 0}
      in
      nowhere, nowhere
    ;;
    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.ExLet
        (_loc, false,
         [MLast.PaLid (_loc, "nowhere"),
          MLast.ExRec
            (_loc,
             [MLast.PaAcc
                (_loc, MLast.PaUid (_loc, "Lexing"),
                 MLast.PaLid (_loc, "pos_lnum")),
              MLast.ExInt (_loc, "1");
              MLast.PaAcc
                (_loc, MLast.PaUid (_loc, "Lexing"),
                 MLast.PaLid (_loc, "pos_cnum")),
              MLast.ExInt (_loc, "0")],
             Some
               (MLast.ExAcc
                  (_loc, MLast.ExUid (_loc, "Lexing"),
                   MLast.ExLid (_loc, "dummy_pos"))))],
         MLast.ExTup
           (_loc,
            [MLast.ExLid (_loc, "nowhere"); MLast.ExLid (_loc, "nowhere")]))
    ;;
    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 (_, "MLast"), 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 (_, m), 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, (m ^ "." ^ 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 (_, "MLast"), 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.ExAcc (_, MLast.ExUid (_, m), MLast.ExUid (_, s)) ->
      MLast.ExApp
        (_loc,
         MLast.ExApp
           (_loc,
            MLast.ExAcc
              (_loc, MLast.ExUid (_loc, "Qast"), MLast.ExUid (_loc, "Node")),
            MLast.ExStr (_loc, (m ^ "." ^ 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 =
             let nowhere =
               {(Lexing.dummy_pos) with Lexing.pos_lnum = 1;
                 Lexing.pos_cnum = 0}
             in
             nowhere, nowhere
           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.TyAcc
                 (_loc, MLast.TyUid (_loc, "Lexing"),
                  MLast.TyLid (_loc, "position"));
               MLast.TyAcc
                 (_loc, MLast.TyUid (_loc, "Lexing"),
                  MLast.TyLid (_loc, "position"))])),
        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
;;

let zero_loc = {(Lexing.dummy_pos) with Lexing.pos_cnum = 0};;

open Pcaml;;
let symbol = Grammar.Entry.create gram "symbol";;
let semi_sep =
  if !syntax_name = "Scheme" then
    Grammar.Entry.of_parser gram "'/'"
      (fun (strm__ : _ Stream.t) ->
         match Stream.peek strm__ with
           Some ("", "/") -> Stream.junk strm__; ()
         | _ -> raise Stream.Failure)
  else
    Grammar.Entry.of_parser gram "';'"
      (fun (strm__ : _ Stream.t) ->
         match Stream.peek strm__ with
           Some ("", ";") -> Stream.junk strm__; ()
         | _ -> raise Stream.Failure)
;;

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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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.Snterm
                (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))],
             Gramext.action
               (fun _ (e : 'entry)
                  (_loc : Lexing.position * Lexing.position) ->
                  (e : 'e__1))])],
      Gramext.action
        (fun (el : 'e__1 list) (sl : 'global option) (f : 'efunction)
           (_loc : Lexing.position * Lexing.position) ->
           (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.Snterm
                (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))],
             Gramext.action
               (fun _ (e : 'entry)
                  (_loc : Lexing.position * Lexing.position) ->
                  (e : 'e__2))])],
      Gramext.action
        (fun (el : 'e__2 list) (sl : 'global option) (g : string)
           (_loc : Lexing.position * Lexing.position) ->
           (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.Snterm
            (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))],
      Gramext.action
        (fun (sl : 'symbol list) _ (n : 'name)
           (_loc : Lexing.position * Lexing.position) ->
           (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.Snterm
            (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))],
      Gramext.action
        (fun (sl : 'symbol list) _ (n : 'name) (g : string)
           (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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.Snterm
         (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))],
      Gramext.action
        (fun _ (f : 'qualid) _ _ (_loc : Lexing.position * Lexing.position) ->
           (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.Snterm
         (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e))],
      Gramext.action
        (fun _ (sl : 'name list) _ _
           (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           ({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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (MLast.ExApp
              (_loc,
               MLast.ExAcc
                 (_loc, MLast.ExUid (_loc, "Gramext"),
                  MLast.ExUid (_loc, "Before")),
               n) :
            'position));
      [Gramext.Stoken ("UIDENT", "LAST")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) ->
           (MLast.ExAcc
              (_loc, MLast.ExUid (_loc, "Gramext"),
               MLast.ExUid (_loc, "Last")) :
            'position));
      [Gramext.Stoken ("UIDENT", "FIRST")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           ({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 : Lexing.position * Lexing.position) ->
           (MLast.ExAcc
              (_loc, MLast.ExUid (_loc, "Gramext"),
               MLast.ExUid (_loc, "NonA")) :
            'assoc));
      [Gramext.Stoken ("UIDENT", "RIGHTA")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) ->
           (MLast.ExAcc
              (_loc, MLast.ExUid (_loc, "Gramext"),
               MLast.ExUid (_loc, "RightA")) :
            'assoc));
      [Gramext.Stoken ("UIDENT", "LEFTA")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (retype_rule_list_without_patterns _loc rules : 'rule_list));
      [Gramext.Stoken ("", "["); Gramext.Stoken ("", "]")],
      Gramext.action
        (fun _ _ (_loc : Lexing.position * Lexing.position) ->
           ([] : '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.Snterm
            (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)))],
      Gramext.action
        (fun (psl : 'psymbol list)
           (_loc : Lexing.position * Lexing.position) ->
           ({prod = psl; action = None} : 'rule));
      [Gramext.Slist0sep
         (Gramext.Snterm
            (Grammar.Entry.obj (psymbol : 'psymbol Grammar.Entry.e)),
          Gramext.Snterm
            (Grammar.Entry.obj (semi_sep : 'semi_sep Grammar.Entry.e)));
       Gramext.Stoken ("", "->");
       Gramext.Snterm (Grammar.Entry.obj (expr : 'expr Grammar.Entry.e))],
      Gramext.action
        (fun (act : 'expr) _ (psl : 'psymbol list)
           (_loc : Lexing.position * Lexing.position) ->
           ({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 : Lexing.position * Lexing.position) ->
           ({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 : Lexing.position * Lexing.position) ->
           ({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 : Lexing.position * Lexing.position) ->
                  (s : 'e__3))])],
      Gramext.action
        (fun (lev : 'e__3 option) (i : string)
           (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           ({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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
                  (t : 'e__5))])],
      Gramext.action
        (fun (sep : 'e__5 option) (s : 'symbol) _
           (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
                  (t : 'e__4))])],
      Gramext.action
        (fun (sep : 'e__4 option) (s : 'symbol) _
           (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
                  (s : 'e__7))])],
      Gramext.action
        (fun (lev : 'e__7 option) (n : 'name)
           (_loc : Lexing.position * Lexing.position) ->
           ({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 : Lexing.position * Lexing.position) ->
                  (s : 'e__6))])],
      Gramext.action
        (fun (lev : 'e__6 option) (e : 'qualid) _ (i : string)
           (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (let text = TXtok (_loc, x, e) in
            {used = []; text = text; styp = STlid (_loc, "string")} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "")],
      Gramext.action
        (fun (x : string) (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           ({used = []; text = TXnext _loc; styp = STself (_loc, "NEXT")} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "SELF")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) ->
           ({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 : Lexing.position * Lexing.position) ->
           (MLast.PaTup (_loc, (p :: pl)) : 'pattern));
      [Gramext.Stoken ("", "("); Gramext.Sself; Gramext.Stoken ("", ")")],
      Gramext.action
        (fun _ (p : 'pattern) _ (_loc : Lexing.position * Lexing.position) ->
           (p : 'pattern));
      [Gramext.Stoken ("", "_")],
      Gramext.action
        (fun _ (_loc : Lexing.position * Lexing.position) ->
           (MLast.PaAny _loc : 'pattern));
      [Gramext.Stoken ("LIDENT", "")],
      Gramext.action
        (fun (i : string) (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (pl @ [p] : 'patterns_comma))];
     None, None,
     [[Gramext.Snterm
         (Grammar.Entry.obj (pattern : 'pattern Grammar.Entry.e))],
      Gramext.action
        (fun (p : 'pattern) (_loc : Lexing.position * Lexing.position) ->
           ([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 : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (MLast.ExAcc (_loc, e1, e2) : 'qualid))];
     None, None,
     [[Gramext.Stoken ("LIDENT", "")],
      Gramext.action
        (fun (i : string) (_loc : Lexing.position * Lexing.position) ->
           (MLast.ExLid (_loc, i) : 'qualid));
      [Gramext.Stoken ("UIDENT", "")],
      Gramext.action
        (fun (i : string) (_loc : Lexing.position * Lexing.position) ->
           (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 : Lexing.position * Lexing.position) ->
           (let shift = Reloc.shift_pos (String.length "$") (fst _loc) in
            let e =
              try Grammar.Entry.parse Pcaml.expr_eoi (Stream.of_string i) with
                Exc_located ((bp, ep), exc) ->
                  raise_with_loc (Reloc.adjust_loc shift (bp, ep)) exc
            in
            Pcaml.expr_reloc (fun (bp, ep) -> Reloc.adjust_loc shift (bp, ep))
              zero_loc e :
            'string));
      [Gramext.Stoken ("STRING", "")],
      Gramext.action
        (fun (s : string) (_loc : Lexing.position * Lexing.position) ->
           (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";;
