ocaml/camlp4/ocaml_src/meta/pa_extend.ml

(* camlp4r pa_extend.cmo q_MLast.cmo *)
(***********************************************************************)
(*                                                                     *)
(*                             Camlp4                                  *)
(*                                                                     *)
(*        Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt     *)
(*                                                                     *)
(*  Copyright 2001 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 name = { expr : MLast.expr; tvar : string; loc : int * int };;

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

type used = Unused | UsedScanned | UsedNotScanned;;

let mark_used modif ht n =
  try
    let rll = Hashtbl.find_all ht n.tvar 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 text_of_psymbol_list loc gmod psl tvar =
  List.fold_right
    (fun ps txt ->
       let x = ps.symbol.text gmod tvar in
       MLast.ExApp (loc, MLast.ExApp (loc, MLast.ExUid (loc, "::"), x), txt))
    psl (MLast.ExUid (loc, "[]"))
;;

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 rec expr_fa al =
  function
    MLast.ExApp (_, f, a) -> expr_fa (a :: al) f
  | f -> f, al
;;

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 quot_act e =
  let loc = MLast.loc_of_expr e in
  match e with
    MLast.ExUid (_, "None") ->
      MLast.ExApp
        (loc, MLast.ExUid (loc, "Option"), MLast.ExUid (loc, "None"))
  | MLast.ExApp (_, MLast.ExUid (_, "Some"), e) ->
      MLast.ExApp
        (loc, MLast.ExUid (loc, "Option"),
         MLast.ExApp (loc, MLast.ExUid (loc, "Some"), quot_act e))
  | MLast.ExUid (_, "False") ->
      MLast.ExApp (loc, MLast.ExUid (loc, "Bool"), MLast.ExUid (loc, "False"))
  | MLast.ExUid (_, "True") ->
      MLast.ExApp (loc, MLast.ExUid (loc, "Bool"), MLast.ExUid (loc, "True"))
  | MLast.ExApp (_, MLast.ExUid (_, "List"), _) -> e
  | MLast.ExApp (_, MLast.ExUid (_, "Option"), _) -> e
  | MLast.ExApp (_, MLast.ExUid (_, "Str"), _) -> e
  | MLast.ExUid (_, "[]") ->
      MLast.ExApp (loc, MLast.ExUid (loc, "List"), MLast.ExUid (loc, "[]"))
  | MLast.ExApp
      (_, MLast.ExApp (_, MLast.ExUid (_, "::"), e), MLast.ExUid (_, "[]")) ->
      MLast.ExApp
        (loc, MLast.ExUid (loc, "List"),
         MLast.ExApp
           (loc, MLast.ExApp (loc, MLast.ExUid (loc, "::"), quot_act e),
            MLast.ExUid (loc, "[]")))
  | MLast.ExApp (_, MLast.ExApp (_, MLast.ExUid (_, "::"), e1), e2) ->
      MLast.ExApp
        (loc, MLast.ExApp (loc, MLast.ExUid (loc, "Cons"), quot_act e1),
         quot_act e2)
  | MLast.ExApp (_, _, _) ->
      let (f, al) = expr_fa [] e in
      let al = List.map quot_act al in
      begin match f with
        MLast.ExUid (_, c) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc, MLast.ExUid (loc, "Node"), MLast.ExStr (loc, c)),
             mklistexp loc al)
      | MLast.ExAcc (_, _, MLast.ExUid (_, c)) ->
          MLast.ExApp
            (loc,
             MLast.ExApp
               (loc, MLast.ExUid (loc, "Node"), MLast.ExStr (loc, c)),
             mklistexp loc al)
      | _ -> e
      end
  | MLast.ExLid (_, s) ->
      if s = !(Stdpp.loc_name) then MLast.ExUid (loc, "Loc") else e
  | MLast.ExStr (_, s) ->
      MLast.ExApp (loc, MLast.ExUid (loc, "Str"), MLast.ExStr (loc, s))
  | MLast.ExTup (_, el) ->
      let el = List.map quot_act el in
      MLast.ExApp (loc, MLast.ExUid (loc, "Tuple"), mklistexp loc el)
  | _ -> 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_act 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.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 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 = 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 text_of_rule_list loc gmod rtvar rl tvar =
  List.fold_left
    (fun txt r ->
       let sl = text_of_psymbol_list loc gmod r.prod tvar in
       let ac = text_of_action loc r.prod rtvar r.action tvar in
       MLast.ExApp
         (loc,
          MLast.ExApp
            (loc, MLast.ExUid (loc, "::"), MLast.ExTup (loc, [sl; ac])),
          txt))
    (MLast.ExUid (loc, "[]")) 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, "::"), s.text gmod ""),
            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 sself loc gmod n =
  MLast.ExAcc (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Sself"))
;;
let snext loc gmod n =
  MLast.ExAcc (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Snext"))
;;
let stoken loc s e gmod n =
  MLast.ExApp
    (loc,
     MLast.ExAcc
       (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Stoken")),
     MLast.ExTup (loc, [MLast.ExStr (loc, s); e]))
;;
let snterm loc n lev gmod tvar =
  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 sself loc gmod tvar
      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)))))
;;
let slist loc min sep symb gmod n =
  let txt = symb.text gmod "" in
  match min, sep 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 = s.text gmod n 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 = s.text gmod n in
      MLast.ExApp
        (loc,
         MLast.ExApp
           (loc,
            MLast.ExAcc
              (loc, MLast.ExUid (loc, "Gramext"),
               MLast.ExUid (loc, "Slist1sep")),
            txt),
         x)
;;
let sopt loc symb gmod n =
  let txt = symb.text gmod "" in
  MLast.ExApp
    (loc,
     MLast.ExAcc
       (loc, MLast.ExUid (loc, "Gramext"), MLast.ExUid (loc, "Sopt")),
     txt)
;;
let srules loc t rl gmod tvar =
  let e = text_of_rule_list loc gmod t rl "" in
  MLast.ExApp
    (loc,
     MLast.ExAcc
       (loc, MLast.ExUid (loc, "Gramext"), MLast.ExLid (loc, "srules")),
     e)
;;

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

let ssopt loc symb =
  let psymbol p s t =
    let symb = {used = []; text = s; styp = fun _ -> t} in
    {pattern = Some p; symbol = symb}
  in
  let rl =
    let r1 =
      let prod =
        let n = mk_name loc (MLast.ExLid (loc, "anti_opt")) in
        [psymbol (MLast.PaLid (loc, "a")) (snterm loc n None)
           (MLast.TyQuo (loc, "anti_opt"))]
      in
      let act = MLast.ExLid (loc, "a") in {prod = prod; action = Some act}
    in
    let r2 =
      let psymb =
        let symb =
          {used = []; text = sopt loc symb;
           styp =
             fun n ->
               MLast.TyApp (loc, MLast.TyLid (loc, "option"), symb.styp n)}
        in
        let patt = MLast.PaLid (loc, "o") in
        {pattern = Some patt; symbol = symb}
      in
      let act =
        MLast.ExApp (loc, MLast.ExUid (loc, "Option"), MLast.ExLid (loc, "o"))
      in
      {prod = [psymb]; action = Some act}
    in
    [r1; r2]
  in
  srules loc "anti" rl
;;

let sslist_aux loc min sep s =
  let psymbol p s t =
    let symb = {used = []; text = s; styp = fun _ -> t} in
    {pattern = Some p; symbol = symb}
  in
  let rl =
    let r1 =
      let prod =
        let n = mk_name loc (MLast.ExLid (loc, "anti_list")) in
        [psymbol (MLast.PaLid (loc, "a")) (snterm loc n None)
           (MLast.TyQuo (loc, "anti_list"))]
      in
      let act = MLast.ExLid (loc, "a") in {prod = prod; action = Some act}
    in
    let r2 =
      let psymb =
        let symb =
          {used = []; text = slist loc min sep s;
           styp =
             fun n -> MLast.TyApp (loc, MLast.TyLid (loc, "list"), s.styp n)}
        in
        let patt = MLast.PaLid (loc, "l") in
        {pattern = Some patt; symbol = symb}
      in
      let act =
        MLast.ExApp (loc, MLast.ExUid (loc, "List"), MLast.ExLid (loc, "l"))
      in
      {prod = [psymb]; action = Some act}
    in
    [r1; r2]
  in
  srules loc "anti" rl
;;

let sslist loc min sep s =
  match s.text "" "" with
    MLast.ExAcc
      (_, MLast.ExUid (_, "Gramext"), MLast.ExUid (_, ("Sself" | "Snext"))) ->
      slist loc min sep s
  | _ -> sslist_aux loc min sep s
;;

let is_global e =
  function
    None -> true
  | Some gl -> List.exists (fun n -> n.tvar = e.name.tvar) gl
;;

let text_of_entry loc gmod gl 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 levels =
    if !quotify && is_global e gl then
      let rec loop =
        function
          [] -> []
        | [level] ->
            let level =
              let rule =
                let psymbol =
                  let s =
                    let n = "a_" ^ e.name.tvar in
                    let e = mk_name loc (MLast.ExLid (loc, n)) in
                    {used = []; text = snterm loc e None;
                     styp = fun _ -> MLast.TyLid (loc, "ast")}
                  in
                  {pattern = Some (MLast.PaLid (loc, "a")); symbol = s}
                in
                {prod = [psymbol]; action = Some (MLast.ExLid (loc, "a"))}
              in
              {level with rules = rule :: level.rules}
            in
            [level]
        | level :: levels -> level :: loop levels
      in
      loop e.levels
    else e.levels
  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 =
             text_of_rule_list loc gmod e.name.tvar level.rules e.name.tvar
           in
           MLast.ExApp
             (loc,
              MLast.ExApp
                (loc, MLast.ExUid (loc, "::"),
                 MLast.ExTup (loc, [lab; ass; rl])),
              txt)
         in
         txt)
      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 =
        List.fold_right
          (fun e ll ->
             match e.name.expr with
               MLast.ExLid (_, _) ->
                 if List.exists (fun n -> e.name.tvar = n.tvar) nl 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 gl 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 gl 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 gl 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 = snterm loc name lev in
            let styp _ = MLast.TyQuo (loc, i) in
            let symb = {used = [name]; 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) ->
           (let styp n =
              let t = s.styp n in
              MLast.TyApp (loc, MLast.TyLid (loc, "option"), t)
            in
            let text = if !quotify then ssopt loc s else sopt loc s 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) ->
           (let used =
              match sep with
                Some symb -> symb.used @ s.used
              | None -> s.used
            in
            let styp n =
              let t = s.styp n in
              MLast.TyApp (loc, MLast.TyLid (loc, "list"), t)
            in
            let text =
              if !quotify then sslist loc true sep s else 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) ->
           (let used =
              match sep with
                Some symb -> symb.used @ s.used
              | None -> s.used
            in
            let styp n =
              let t = s.styp n in
              MLast.TyApp (loc, MLast.TyLid (loc, "list"), t)
            in
            let text =
              if !quotify then sslist loc false sep s
              else 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]; text = snterm loc n lev;
             styp = fun _ -> MLast.TyQuo (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]; text = snterm loc n lev;
             styp = fun _ -> MLast.TyQuo (loc, n.tvar)} :
            'symbol));
      [Gramext.Snterm (Grammar.Entry.obj (string : 'string Grammar.Entry.e))],
      Gramext.action
        (fun (e : 'string) (loc : int * int) ->
           (let text = stoken loc "" e in
            {used = []; text = text;
             styp = fun _ -> MLast.TyLid (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 = stoken loc x e in
            {used = []; text = text;
             styp = fun _ -> MLast.TyLid (loc, "string")} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "")],
      Gramext.action
        (fun (x : string) (loc : int * int) ->
           (let text =
              if !quotify then sstoken loc x
              else stoken loc x (MLast.ExStr (loc, ""))
            in
            {used = []; text = text;
             styp = fun _ -> MLast.TyLid (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 = srules loc t rl;
             styp = fun _ -> MLast.TyQuo (loc, t)} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "NEXT")],
      Gramext.action
        (fun _ (loc : int * int) ->
           (let styp n =
              if n = "" then
                Stdpp.raise_with_loc loc
                  (Stream.Error "'NEXT' illegal in anonymous entry level")
              else MLast.TyQuo (loc, n)
            in
            {used = []; text = snext loc; styp = styp} :
            'symbol));
      [Gramext.Stoken ("UIDENT", "SELF")],
      Gramext.action
        (fun _ (loc : int * int) ->
           (let styp n =
              if n = "" then
                Stdpp.raise_with_loc loc
                  (Stream.Error "'SELF' illegal in anonymous entry level")
              else MLast.TyQuo (loc, n)
            in
            {used = []; text = sself loc; styp = styp} :
            '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";;