Source file pa_scheme.ml

# 1 "pa_schemer.orig.ml"
(* camlp5 pa_r.cmo pa_rp.cmo pa_extend.cmo q_MLast.cmo pr_dump.cmo *)
(* pa_scheme.ml,v *)
(* Copyright (c) INRIA 2007-2017 *)

open Asttools
open Pcaml
open Exparser
open Versdep

(* Buffer *)

module Buff =
  struct
    let buff = ref (string_create 80)
    let store len x =
      if len >= string_length !buff then
        buff := string_cat !buff (string_create (string_length !buff));
      string_set !buff len x;
      succ len
    let mstore len s =
      let rec add_rec len i =
        if i == String.length s then len
        else add_rec (store len s.[i]) (succ i)
      in
      add_rec len 0
    let get len = bytes_to_string (string_sub !buff 0 len)
  end

let rename_id s =
  if String.length s > 0 && s.[String.length s - 1] = '#' then
    String.sub s 0 (String.length s - 1)
  else !(Pcaml.rename_id) s

(* Lexer *)

let rec skip_to_eol len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('\n' | '\r' as c) -> Stream.junk strm__; Buff.store len c
  | Some c -> Stream.junk strm__; skip_to_eol (Buff.store len c) strm__
  | _ -> raise Stream.Failure

let no_ident = ['('; ')'; '['; ']'; '{'; '}'; ' '; '\t'; '\n'; '\r'; ';'; '.']

let rec ident len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some x when not (List.mem x no_ident) ->
      Stream.junk strm__; ident (Buff.store len x) strm__
  | _ -> len

let identifier kwt s =
  let con =
    try ignore (Hashtbl.find kwt s : string); "" with
      Not_found ->
        match s.[0] with
          'A'..'Z' -> "UIDENT"
        | _ -> "LIDENT"
  in
  con, s

let rec string len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '"' -> Stream.junk strm__; Buff.get len
  | Some '\\' ->
      Stream.junk strm__;
      begin match Stream.peek strm__ with
        Some c ->
          Stream.junk strm__;
          string (Buff.store (Buff.store len '\\') c) strm__
      | _ -> raise (Stream.Error "")
      end
  | Some x -> Stream.junk strm__; string (Buff.store len x) strm__
  | _ -> raise Stream.Failure

let rec end_exponent_part_under len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('0'..'9' as c) ->
      Stream.junk strm__; end_exponent_part_under (Buff.store len c) strm__
  | _ -> "FLOAT", Buff.get len

let end_exponent_part len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('0'..'9' as c) ->
      Stream.junk strm__; end_exponent_part_under (Buff.store len c) strm__
  | _ -> raise (Stream.Error "ill-formed floating-point constant")

let exponent_part len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('+' | '-' as c) ->
      Stream.junk strm__; end_exponent_part (Buff.store len c) strm__
  | _ -> end_exponent_part len strm__

let rec decimal_part len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('0'..'9' as c) ->
      Stream.junk strm__; decimal_part (Buff.store len c) strm__
  | Some ('e' | 'E') ->
      Stream.junk strm__; exponent_part (Buff.store len 'E') strm__
  | _ -> "FLOAT", Buff.get len

let rec number len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('0'..'9' as c) ->
      Stream.junk strm__; number (Buff.store len c) strm__
  | Some '.' -> Stream.junk strm__; decimal_part (Buff.store len '.') strm__
  | Some ('e' | 'E') ->
      Stream.junk strm__; exponent_part (Buff.store len 'E') strm__
  | Some 'l' -> Stream.junk strm__; "INT_l", Buff.get len
  | Some 'L' -> Stream.junk strm__; "INT_L", Buff.get len
  | Some 'n' -> Stream.junk strm__; "INT_n", Buff.get len
  | _ -> "INT", Buff.get len

let binary (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('0'..'1' as c) -> Stream.junk strm__; c
  | _ -> raise Stream.Failure

let octal (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('0'..'7' as c) -> Stream.junk strm__; c
  | _ -> raise Stream.Failure

let hexa (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('0'..'9' | 'a'..'f' | 'A'..'F' as c) -> Stream.junk strm__; c
  | _ -> raise Stream.Failure

let rec digits_under kind len (strm__ : _ Stream.t) =
  match try Some (kind strm__) with Stream.Failure -> None with
    Some d -> digits_under kind (Buff.store len d) strm__
  | _ ->
      match Stream.peek strm__ with
        Some '_' ->
          Stream.junk strm__; digits_under kind (Buff.store len '_') strm__
      | Some 'l' -> Stream.junk strm__; "INT_l", Buff.get len
      | Some 'L' -> Stream.junk strm__; "INT_L", Buff.get len
      | Some 'n' -> Stream.junk strm__; "INT_n", Buff.get len
      | _ -> "INT", Buff.get len

let digits kind bp len (strm__ : _ Stream.t) =
  match try Some (kind strm__) with Stream.Failure -> None with
    Some d ->
      begin try digits_under kind (Buff.store len d) strm__ with
        Stream.Failure -> raise (Stream.Error "")
      end
  | _ ->
      let ep = Stream.count strm__ in
      Ploc.raise (Ploc.make_unlined (bp, ep))
        (Failure "ill-formed integer constant")

let base_number kwt bp len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('b' | 'B') ->
      Stream.junk strm__; digits binary bp (Buff.store len 'b') strm__
  | Some ('o' | 'O') ->
      Stream.junk strm__; digits octal bp (Buff.store len 'o') strm__
  | Some ('x' | 'X') ->
      Stream.junk strm__; digits hexa bp (Buff.store len 'x') strm__
  | _ ->
      let len = ident (Buff.store 0 '#') strm__ in
      identifier kwt (Buff.get len)

let rec operator len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '.' -> Stream.junk strm__; Buff.store len '.'
  | _ -> len

let char_or_quote_id x (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '\'' -> Stream.junk strm__; "CHAR", String.make 1 x
  | _ ->
      let s = strm__ in
      let ep = Stream.count strm__ in
      if List.mem x no_ident then
        Ploc.raise (Ploc.make_unlined (ep - 2, ep - 1))
          (Stream.Error "bad quote")
      else
        let len = Buff.store (Buff.store 0 '\'') x in
        let s = Buff.get (ident len s) in "LIDENT", s

let rec char len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '\'' -> Stream.junk strm__; len
  | Some x -> Stream.junk strm__; char (Buff.store len x) strm__
  | _ -> raise Stream.Failure

let quote (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '\\' ->
      Stream.junk strm__;
      begin match Stream.peek strm__ with
        Some c ->
          Stream.junk strm__;
          let len =
            try char (Buff.store (Buff.store 0 '\\') c) strm__ with
              Stream.Failure -> raise (Stream.Error "")
          in
          "CHAR", Buff.get len
      | _ -> raise (Stream.Error "")
      end
  | Some x -> Stream.junk strm__; char_or_quote_id x strm__
  | _ -> raise Stream.Failure

let rec antiquot_rest bp len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '$' -> Stream.junk strm__; len
  | Some x ->
      Stream.junk strm__;
      begin try antiquot_rest bp (Buff.store len x) strm__ with
        Stream.Failure -> raise (Stream.Error "")
      end
  | _ ->
      let ep = Stream.count strm__ in
      Ploc.raise (Ploc.make_unlined (bp, ep))
        (Failure "antiquotation not terminated")

let antiloc d1 d2 s = Printf.sprintf "%d,%d:%s" d1 d2 s

let rec antiquot_loc bp len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '$' ->
      Stream.junk strm__;
      let ep = Stream.count strm__ in antiloc bp ep (":" ^ Buff.get len)
  | Some ('a'..'z' | 'A'..'Z' | '0'..'9' | '_' as c) ->
      Stream.junk strm__;
      begin try antiquot_loc bp (Buff.store len c) strm__ with
        Stream.Failure -> raise (Stream.Error "")
      end
  | Some ':' ->
      Stream.junk strm__;
      let len =
        try antiquot_rest bp (Buff.store len ':') strm__ with
          Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in antiloc bp ep (Buff.get len)
  | Some c ->
      Stream.junk strm__;
      let len =
        try antiquot_rest bp (Buff.store len c) strm__ with
          Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in antiloc bp ep (":" ^ Buff.get len)
  | _ ->
      let ep = Stream.count strm__ in
      Ploc.raise (Ploc.make_unlined (bp, ep))
        (Failure "antiquotation not terminated")

let rec next_token_after_spaces kwt (strm__ : _ Stream.t) =
  let bp = Stream.count strm__ in
  match Stream.peek strm__ with
    Some '(' -> Stream.junk strm__; ("", "("), (bp, bp + 1)
  | Some ')' -> Stream.junk strm__; ("", ")"), (bp, bp + 1)
  | Some '[' -> Stream.junk strm__; ("", "["), (bp, bp + 1)
  | Some ']' -> Stream.junk strm__; ("", "]"), (bp, bp + 1)
  | Some '{' -> Stream.junk strm__; ("", "{"), (bp, bp + 1)
  | Some '}' -> Stream.junk strm__; ("", "}"), (bp, bp + 1)
  | Some '.' -> Stream.junk strm__; ("DOT", ""), (bp, bp + 1)
  | Some '"' ->
      Stream.junk strm__;
      let s =
        try string 0 strm__ with Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in ("STRING", s), (bp, ep)
  | Some '\'' ->
      Stream.junk strm__;
      let tok =
        try quote strm__ with Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in tok, (bp, ep)
  | Some '<' ->
      Stream.junk strm__;
      let tok =
        try less kwt strm__ with Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in tok, (bp, ep)
  | Some '-' ->
      Stream.junk strm__;
      let tok =
        try minus bp kwt strm__ with Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in tok, (bp, ep)
  | Some '#' ->
      Stream.junk strm__;
      let tok =
        try sharp bp kwt strm__ with Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in tok, (bp, ep)
  | Some ('0'..'9' as c) ->
      Stream.junk strm__;
      let tok =
        try number (Buff.store 0 c) strm__ with
          Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in tok, (bp, ep)
  | Some ('+' | '*' | '/' | '~' as c) ->
      Stream.junk strm__;
      let len =
        try ident (Buff.store 0 c) strm__ with
          Stream.Failure -> raise (Stream.Error "")
      in
      let len =
        try operator len strm__ with Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in identifier kwt (Buff.get len), (bp, ep)
  | Some '$' ->
      Stream.junk strm__;
      let tok =
        try dollar bp kwt strm__ with
          Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in tok, (bp, ep)
  | Some c ->
      Stream.junk strm__;
      let len =
        try ident (Buff.store 0 c) strm__ with
          Stream.Failure -> raise (Stream.Error "")
      in
      let ep = Stream.count strm__ in identifier kwt (Buff.get len), (bp, ep)
  | _ -> ("EOI", ""), (bp, bp + 1)
and dollar bp kwt strm =
  if !(Plexer.force_antiquot_loc) then "ANTIQUOT_LOC", antiquot_loc bp 0 strm
  else
    let (strm__ : _ Stream.t) = strm in
    let len = ident (Buff.store 0 '$') strm__ in identifier kwt (Buff.get len)
and sharp bp kwt (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '(' -> Stream.junk strm__; "", "#("
  | _ -> base_number kwt bp (Buff.store 0 '0') strm__
and minus bp kwt (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '.' -> Stream.junk strm__; identifier kwt "-."
  | Some ('0'..'9' as c) ->
      Stream.junk strm__;
      begin try number (Buff.store (Buff.store 0 '-') c) strm__ with
        Stream.Failure -> raise (Stream.Error "")
      end
  | Some '#' ->
      Stream.junk strm__;
      begin try base_number kwt bp (Buff.mstore 0 "-0") strm__ with
        Stream.Failure -> raise (Stream.Error "")
      end
  | _ ->
      let len = ident (Buff.store 0 '-') strm__ in
      identifier kwt (Buff.get len)
and less kwt (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ':' ->
      Stream.junk strm__;
      let lab =
        try label 0 strm__ with Stream.Failure -> raise (Stream.Error "")
      in
      begin match Stream.peek strm__ with
        Some '<' ->
          Stream.junk strm__;
          let q =
            try quotation 0 strm__ with
              Stream.Failure -> raise (Stream.Error "")
          in
          "QUOT", lab ^ ":" ^ q
      | _ -> raise (Stream.Error "'<' expected")
      end
  | _ ->
      let len = ident (Buff.store 0 '<') strm__ in
      identifier kwt (Buff.get len)
and label len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some ('a'..'z' | 'A'..'Z' | '_' as c) ->
      Stream.junk strm__; label (Buff.store len c) strm__
  | _ -> Buff.get len
and quotation len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '>' -> Stream.junk strm__; quotation_greater len strm__
  | Some x -> Stream.junk strm__; quotation (Buff.store len x) strm__
  | _ -> failwith "quotation not terminated"
and quotation_greater len (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '>' -> Stream.junk strm__; Buff.get len
  | _ -> quotation (Buff.store len '>') strm__

let get_buff len _ = Buff.get len

let rec lexer len kwt (strm__ : _ Stream.t) =
  let bp = Stream.count strm__ in
  match Stream.peek strm__ with
    Some ('\t' | '\r' as c) ->
      Stream.junk strm__; lexer (Buff.store len c) kwt strm__
  | Some ' ' ->
      Stream.junk strm__; after_space (Buff.store len ' ') kwt strm__
  | Some ';' ->
      Stream.junk strm__;
      let len =
        try skip_to_eol (Buff.store len ';') strm__ with
          Stream.Failure -> raise (Stream.Error "")
      in
      lexer len kwt strm__
  | Some '\n' ->
      Stream.junk strm__;
      let s = strm__ in
      let len = Buff.store len '\n' in
      if !(Sys.interactive) then Buff.get len, (("NL", ""), (bp, bp + 1))
      else lexer len kwt s
  | _ ->
      let comm = get_buff len strm__ in
      let a =
        try next_token_after_spaces kwt strm__ with
          Stream.Failure -> raise (Stream.Error "")
      in
      comm, a
and after_space len kwt (strm__ : _ Stream.t) =
  match Stream.peek strm__ with
    Some '.' ->
      Stream.junk strm__;
      let ep = Stream.count strm__ in
      Buff.get len, (("SPACEDOT", ""), (ep - 1, ep))
  | _ -> lexer len kwt strm__

let lexer_using kwt (con, prm) =
  match con with
    "CHAR" | "DOT" | "EOI" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" |
    "LIDENT" | "NL" | "QUOT" | "SPACEDOT" | "STRING" | "UIDENT" ->
      ()
  | "ANTIQUOT" | "ANTIQUOT_LOC" -> ()
  | "" ->
      (try Hashtbl.find kwt prm; () with Not_found -> Hashtbl.add kwt prm prm)
  | _ ->
      raise
        (Plexing.Error
           ("the constructor \"" ^ con ^ "\" is not recognized by Plexer"))

let lexer_text (con, prm) =
  if con = "" then "'" ^ prm ^ "'"
  else if prm = "" then con
  else con ^ " \"" ^ prm ^ "\""

let lexer_gmake () =
  let kwt = Hashtbl.create 89
  and lexer2 kwt (s, _, _) =
    let (comm, (t, loc)) = lexer 0 kwt s in
    t, Ploc.make_loc !(Plexing.input_file) 1 0 loc comm
  in
  {Plexing.tok_func = Plexing.lexer_func_of_parser (lexer2 kwt);
   Plexing.tok_using = lexer_using kwt;
   Plexing.tok_removing =
     (fun _ -> raise (Match_failure ("pa_schemer.ml", 547, 63)));
   Plexing.tok_match = Plexing.default_match; Plexing.tok_text = lexer_text;
   Plexing.tok_comm = None; Plexing.kwds = kwt}

(* Building AST *)

type sexpr =
    Sacc of MLast.loc * sexpr * sexpr
  | Santi of MLast.loc * string * string
  | Sarr of MLast.loc * sexpr list MLast.v
  | Schar of MLast.loc * string MLast.v
  | Sexpr of MLast.loc * sexpr list
  | Sint of MLast.loc * string MLast.v
  | Sint_l of MLast.loc * string MLast.v
  | Sint_L of MLast.loc * string MLast.v
  | Sint_n of MLast.loc * string MLast.v
  | Sfloat of MLast.loc * string MLast.v
  | Slid of MLast.loc * string
  | Slidv of MLast.loc * string MLast.v
  | Slist of MLast.loc * sexpr list
  | Squot of MLast.loc * string * string
  | Srec of MLast.loc * sexpr list
  | Sstring of MLast.loc * string MLast.v
  | Suid of MLast.loc * string
  | Suidv of MLast.loc * string MLast.v

let loc_of_sexpr =
  function
    Sacc (loc, _, _) | Santi (loc, _, _) | Sarr (loc, _) | Schar (loc, _) |
    Sexpr (loc, _) | Sint (loc, _) | Sint_l (loc, _) | Sint_L (loc, _) |
    Sint_n (loc, _) | Sfloat (loc, _) | Slid (loc, _) | Slidv (loc, _) |
    Slist (loc, _) | Squot (loc, _, _) | Srec (loc, _) | Sstring (loc, _) |
    Suid (loc, _) | Suidv (loc, _) ->
      loc
let error_loc loc err = Ploc.raise loc (Stream.Error (err ^ " expected"))
let error se err = error_loc (loc_of_sexpr se) err
let _ = Pcaml.sync := fun _ -> ()

let strm_n = "strm__"
let peek_fun loc =
  MLast.ExFle
    (loc, MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "Stream")),
     Ploc.VaVal (None, Ploc.VaVal "peek"))
let junk_fun loc =
  MLast.ExFle
    (loc, MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "Stream")),
     Ploc.VaVal (None, Ploc.VaVal "junk"))

let assoc_left_parsed_op_list = ["+"; "*"; "+."; "*."; "land"; "lor"; "lxor"]
let assoc_right_parsed_op_list = ["and"; "or"; "^"; "@"]
let and_by_couple_op_list = ["="; "<>"; "<"; ">"; "<="; ">="; "=="; "!="]

let op_apply loc e1 e2 =
  function
    "and" ->
      MLast.ExApp
        (loc, MLast.ExApp (loc, MLast.ExLid (loc, Ploc.VaVal "&&"), e1), e2)
  | "or" ->
      MLast.ExApp
        (loc, MLast.ExApp (loc, MLast.ExLid (loc, Ploc.VaVal "||"), e1), e2)
  | x ->
      MLast.ExApp
        (loc, MLast.ExApp (loc, MLast.ExLid (loc, Ploc.VaVal x), e1), e2)

let string_se =
  function
    Sstring (loc, Ploc.VaVal s) -> s
  | se -> error se "string"

let rec longident_se =
  function
    Sacc (_, se1, se2) -> longident_se se1 @ longident_se se2
  | Suid (_, s) -> [rename_id s]
  | Slid (_, s) -> [rename_id s]
  | se -> error se "longident"

let lident_expr loc s =
  if String.length s > 1 && s.[0] = '`' then
    let s = String.sub s 1 (String.length s - 1) in
    MLast.ExVrn (loc, Ploc.VaVal s)
  else MLast.ExLid (loc, Ploc.VaVal (rename_id s))

let rec anti_list_map f =
  function
    [Santi (_, ("list" | "_list"), s)] -> Ploc.VaAnt s
  | sel -> Ploc.VaVal (List.map f sel)

let anti_longident_se =
  function
    Santi (_, ("list" | "_list" | "" | "_"), s) -> Ploc.VaAnt s
  | se -> Ploc.VaVal (longident_se se)

let longid_of_string_list loc sl =
  let (h, t) =
    match sl with
      h :: t -> h, t
    | [] -> failwith "longid_of_string_list"
  in
  List.fold_left (fun li s -> MLast.LiAcc (loc, li, Ploc.VaVal s))
    (MLast.LiUid (loc, Ploc.VaVal h)) t

let class_longident_se se =
  let loc = loc_of_sexpr se in
  let sl = longident_se se in
  let (id, sl) = sep_last sl in
  match sl with
    [] -> None, id
  | _ :: _ -> Some (longid_of_string_list loc sl), id

let anti_lid =
  function
    Slid (_, s) -> let s = rename_id s in Some (Ploc.VaVal s)
  | Slidv (_, s) -> Some s
  | Santi (_, ("" | "_"), s) -> Some (Ploc.VaAnt s)
  | _ -> None

let anti_lid_or_error =
  function
    Slid (_, s) -> let s = rename_id s in Ploc.VaVal s
  | Slidv (_, s) -> s
  | Santi (_, ("" | "_"), s) -> Ploc.VaAnt s
  | se -> error se "lowercase identifier"

let anti_uid_or_error =
  function
    Suid (_, s) -> let s = rename_id s in Ploc.VaVal s
  | Suidv (_, s) -> s
  | Santi (_, ("" | "_"), s) -> Ploc.VaVal s
  | se -> error se "uppercase identifier"

let anti_uidopt_or_error =
  function
    Suid (_, s) ->
      let s = rename_id s in let sopt = Some (Ploc.VaVal s) in Ploc.VaVal sopt
  | Suidv (_, s) -> let sopt = Some s in Ploc.VaVal sopt
  | Santi (_, ("" | "_"), s) ->
      let sopt = Some (Ploc.VaVal s) in Ploc.VaVal sopt
  | Slid (_, "_") -> let sopt = None in Ploc.VaVal sopt
  | se -> error se "uppercase identifier"

let rec module_expr_se =
  function
    Sexpr (loc, [Slid (_, "functor"); se1; se2; se3]) ->
      let s = anti_uid_or_error se1 in
      let mt = module_type_se se2 in
      let me = module_expr_se se3 in
      MLast.MeFun (loc, Ploc.VaVal (Some (Ploc.VaVal (Some s), mt)), me)
  | Sexpr (loc, Slid (_, "struct") :: sl) ->
      let mel = anti_list_map str_item_se sl in MLast.MeStr (loc, mel)
  | Sexpr (loc, [se1; se2]) ->
      let me1 = module_expr_se se1 in
      let me2 = module_expr_se se2 in MLast.MeApp (loc, me1, me2)
  | Sexpr (loc, [Slid (_, ":"); se1; se2]) ->
      let me = module_expr_se se1 in
      let mt = module_type_se se2 in MLast.MeTyc (loc, me, mt)
  | Sacc (loc, se1, se2) ->
      let me1 = module_expr_se se1 in
      let me2 = module_expr_se se2 in MLast.MeAcc (loc, me1, me2)
  | Suid (loc, s) -> MLast.MeUid (loc, Ploc.VaVal (rename_id s))
  | Suidv (loc, s) -> MLast.MeUid (loc, s)
  | Santi (loc, "", s) -> MLast.MeXtr (loc, s, None)
  | se -> error se "module expr"
and longid_se =
  function
    Sexpr (loc, [se1; se2]) ->
      let li1 = longid_se se1 in
      let li2 = longid_se se2 in MLast.LiApp (loc, li1, li2)
  | Sacc (loc, se1, se2) ->
      let li1 = longid_se se1 in
      let li2 = longid_se se2 in longid_concat li1 li2
  | Suid (loc, s) -> MLast.LiUid (loc, Ploc.VaVal (rename_id s))
  | Suidv (loc, s) -> MLast.LiUid (loc, s)
  | se -> error se "longid_se"
and longid_lident_se =
  function
    Sacc (loc, se1, se2) ->
      let li1 = longid_se se1 in
      begin match longid_lident_se se2 with
        Some (Ploc.VaVal li2), s ->
          Some (Ploc.VaVal (longid_concat li1 li2)), s
      | None, s -> Some (Ploc.VaVal li1), s
      | _ -> error se2 "longid_lident_se(2)"
      end
  | Slid (loc, s) -> None, Ploc.VaVal s
  | se -> error se "longid_lident_se"
and module_type_se =
  function
    Sexpr (loc, [Slid (_, "functor"); se1; se2; se3]) ->
      let s = anti_uid_or_error se1 in
      let mt1 = module_type_se se2 in
      let mt2 = module_type_se se3 in
      MLast.MtFun (loc, Ploc.VaVal (Some (Ploc.VaVal (Some s), mt1)), mt2)
  | Sexpr (loc, Slid (_, "sig") :: sel) ->
      let sil = anti_list_map sig_item_se sel in MLast.MtSig (loc, sil)
  | Sexpr (loc, Slid (_, "with") :: se :: sel) ->
      let mt = module_type_se se in
      let wcl = anti_list_map with_constr_se sel in MLast.MtWit (loc, mt, wcl)
  | Sacc (loc, se1, Slid (_, s)) ->
      let li1 = longid_se se1 in
      MLast.MtLongLid (loc, li1, Ploc.VaVal (rename_id s))
  | Sacc (loc, _, Suid (_, _)) as se ->
      let li = longid_se se in MLast.MtLong (loc, li)
  | Slid (loc, s) -> MLast.MtLid (loc, Ploc.VaVal (rename_id s))
  | Slidv (loc, s) -> MLast.MtLid (loc, s)
  | Santi (loc, "", s) -> MLast.MtXtr (loc, s, None)
  | se -> error se "module type"
and with_constr_se =
  function
    Sexpr (loc, [Slid (_, ("type" | "typeprivate" as pf)); se1; se2]) ->
      let (tn, tp) =
        match se1 with
          Sexpr (_, se :: sel) ->
            let tn = longid_lident_se se in
            let tp = anti_list_map type_param_se sel in tn, tp
        | se -> longid_lident_se se, Ploc.VaVal []
      in
      let pf = pf = "typeprivate" in
      let te = ctyp_se se2 in
      MLast.WcTyp (loc, Ploc.VaVal tn, tp, Ploc.VaVal pf, te)
  | se -> error se "with constr"
and sig_item_se =
  function
    Sexpr (loc, [Slid (_, "class"); se1; se2]) ->
      let (n, tvl) =
        match se1 with
          Slid (_, n) -> n, []
        | Sexpr (_, Slid (_, n) :: sel) -> n, List.map type_param_se sel
        | se -> error se "class name"
      in
      let cd =
        {MLast.ciLoc = loc; MLast.ciVir = Ploc.VaVal false;
         MLast.ciPrm = loc, Ploc.VaVal tvl; MLast.ciNam = Ploc.VaVal n;
         MLast.ciExp = class_type_se se2; MLast.ciAttributes = Ploc.VaVal []}
      in
      MLast.SgCls (loc, Ploc.VaVal [cd])
  | Sexpr (loc, Slid (_, "exception") :: se :: sel) ->
      let c = anti_uid_or_error se in
      let tl = anti_list_map ctyp_se sel in
      MLast.SgExc
        (loc, (loc, c, Ploc.VaVal [], tl, Ploc.VaVal None, Ploc.VaVal []),
         Ploc.VaVal [])
  | Sexpr (loc, Slid (_, "external") :: se1 :: se2 :: sel) ->
      let i = anti_lid_or_error se1 in
      let t = ctyp_se se2 in
      let pd = anti_list_map string_se sel in
      MLast.SgExt (loc, i, Ploc.VaVal [], t, pd, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "include"); se]) ->
      let mt = module_type_se se in MLast.SgInc (loc, mt, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "module"); se1; se2]) ->
      let s = anti_uid_or_error se1 in
      let mb = module_type_se se2 in
      MLast.SgMod
        (loc, Ploc.VaVal false,
         Ploc.VaVal [Ploc.VaVal (Some s), mb, Ploc.VaVal []])
  | Sexpr (loc, Slid (_, ("module*" | "modulerec*" as rf)) :: sel) ->
      let rf = rf = "modulerec*"
      and lmb = anti_list_map sig_module_se sel in
      MLast.SgMod (loc, Ploc.VaVal rf, lmb)
  | Sexpr (loc, [Slid (_, "moduletype"); se1; se2]) ->
      let s = anti_uid_or_error se1 in
      let mt = module_type_se se2 in MLast.SgMty (loc, s, mt, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "open"); se]) ->
      let lid = longid_se se in MLast.SgOpn (loc, lid, Ploc.VaVal [])
  | Sexpr (loc, Slid (_, "type") :: sel) ->
      let tdl = type_declaration_list_se sel in
      MLast.SgTyp (loc, Ploc.VaVal false, Ploc.VaVal tdl)
  | Sexpr (loc, Slid (_, "type*") :: sel) ->
      let tdl = anti_list_map type_declaration_se sel in
      MLast.SgTyp (loc, Ploc.VaVal false, tdl)
  | Sexpr (loc, [Slid (_, "value"); se1; se2]) ->
      let s = anti_lid_or_error se1 in
      let t = ctyp_se se2 in MLast.SgVal (loc, s, t, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "#"); se1]) ->
      let s = anti_lid_or_error se1 in MLast.SgDir (loc, s, Ploc.VaVal None)
  | Sexpr (loc, [Slid (_, "#"); se1; se2]) ->
      let s = anti_lid_or_error se1
      and e = expr_se se2 in
      MLast.SgDir (loc, s, Ploc.VaVal (Some e))
  | se -> error se "sig item"
and str_item_se se =
  match se with
    Sexpr (loc, [Slid (_, "class"); Slid (_, s); se]) ->
      let ce = class_expr_se se in
      MLast.StCls
        (loc,
         Ploc.VaVal
           [{MLast.ciLoc = loc; MLast.ciVir = Ploc.VaVal false;
             MLast.ciPrm = loc, Ploc.VaVal []; MLast.ciNam = Ploc.VaVal s;
             MLast.ciExp = ce; MLast.ciAttributes = Ploc.VaVal []}])
  | Sexpr (loc, [Slid (_, "class"); Sexpr (_, Slid (_, s) :: sel); se]) ->
      let tpl = List.map type_param_se sel
      and ce = class_expr_se se in
      MLast.StCls
        (loc,
         Ploc.VaVal
           [{MLast.ciLoc = loc; MLast.ciVir = Ploc.VaVal false;
             MLast.ciPrm = loc, Ploc.VaVal tpl; MLast.ciNam = Ploc.VaVal s;
             MLast.ciExp = ce; MLast.ciAttributes = Ploc.VaVal []}])
  | Sexpr (loc, Slid (_, ("define" | "definerec" as r)) :: se :: sel) ->
      let r = r = "definerec" in
      let (p, e, _) = fun_binding_se se (begin_se loc sel) in
      MLast.StVal (loc, Ploc.VaVal r, Ploc.VaVal [p, e, Ploc.VaVal []])
  | Sexpr (loc, Slid (_, ("define*" | "definerec*" as rf)) :: sel) ->
      let rf = rf = "definerec*" in
      let lbs = anti_list_map let_binding_se sel in
      MLast.StVal (loc, Ploc.VaVal rf, lbs)
  | Sexpr (loc, Slid (_, "exception") :: se :: sel) ->
      let c = anti_uid_or_error se in
      let tl = anti_list_map ctyp_se sel in
      MLast.StExc
        (loc,
         Ploc.VaVal
           (MLast.EcTuple
              (loc,
               (loc, c, Ploc.VaVal [], tl, Ploc.VaVal None, Ploc.VaVal []))),
         Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "exceptionrebind"); se1; se2]) ->
      let c = anti_uid_or_error se1 in
      let id = longid_se se2 in
      MLast.StExc
        (loc,
         Ploc.VaVal (MLast.EcRebind (loc, c, Ploc.VaVal id, Ploc.VaVal [])),
         Ploc.VaVal [])
  | Sexpr (loc, Slid (_, "external") :: se1 :: se2 :: sel) ->
      let i = anti_lid_or_error se1 in
      let t = ctyp_se se2 in
      let pd = anti_list_map string_se sel in
      MLast.StExt (loc, i, Ploc.VaVal [], t, pd, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "include"); se]) ->
      let me = module_expr_se se in MLast.StInc (loc, me, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "module"); se1; se2]) ->
      let (i, mb, attrs) = str_module_se (Sexpr (loc, [se1; se2])) in
      MLast.StMod (loc, Ploc.VaVal false, Ploc.VaVal [i, mb, attrs])
  | Sexpr (loc, Slid (_, ("module*" | "modulerec*" as rf)) :: sel) ->
      let rf = rf = "modulerec*" in
      let lmb = anti_list_map str_module_se sel in
      MLast.StMod (loc, Ploc.VaVal rf, lmb)
  | Sexpr (loc, [Slid (_, "moduletype"); se1; se2]) ->
      let s = anti_uid_or_error se1 in
      let mt = module_type_se se2 in MLast.StMty (loc, s, mt, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "open"); se]) ->
      let me = module_expr_se se in
      MLast.StOpn (loc, Ploc.VaVal false, me, Ploc.VaVal [])
  | Sexpr (loc, Slid (_, "type") :: sel) ->
      let tdl = type_declaration_list_se sel in
      MLast.StTyp (loc, Ploc.VaVal false, Ploc.VaVal tdl)
  | Sexpr (loc, Slid (_, "type*") :: sel) ->
      let tdl = anti_list_map type_declaration_se sel in
      MLast.StTyp (loc, Ploc.VaVal false, tdl)
  | Sexpr (loc, [Slid (_, "#"); se1]) ->
      begin match anti_lid se1 with
        Some s -> MLast.StDir (loc, s, Ploc.VaVal None)
      | None ->
          let loc = loc_of_sexpr se in
          let e = expr_se se in MLast.StExp (loc, e, Ploc.VaVal [])
      end
  | Sexpr (loc, [Slid (_, "#"); se1; se2]) ->
      begin match anti_lid se1 with
        Some s ->
          let e = expr_se se2 in MLast.StDir (loc, s, Ploc.VaVal (Some e))
      | None ->
          let loc = loc_of_sexpr se in
          let e = expr_se se in MLast.StExp (loc, e, Ploc.VaVal [])
      end
  | _ ->
      let loc = loc_of_sexpr se in
      let e = expr_se se in MLast.StExp (loc, e, Ploc.VaVal [])
and str_module_se =
  function
    Sexpr (loc, [se1; se2]) ->
      Ploc.VaVal (Some (anti_uid_or_error se1)), module_expr_se se2,
      Ploc.VaVal []
  | se -> error se "module binding"
and sig_module_se =
  function
    Sexpr (loc, [se1; se2]) ->
      Ploc.VaVal (Some (anti_uid_or_error se1)), module_type_se se2,
      Ploc.VaVal []
  | se -> error se "module binding"
and expr_se =
  function
    Sacc (loc, se1, se2) ->
      let e1 = expr_se se1 in
      begin match se2 with
        Slist (loc, [se2]) ->
          let e2 = expr_se se2 in
          MLast.ExSte (loc, Ploc.VaVal ".", e1, Ploc.VaVal [e2])
      | Sexpr (loc, [se2]) ->
          let e2 = expr_se se2 in
          MLast.ExAre (loc, Ploc.VaVal ".", e1, Ploc.VaVal [e2])
      | _ -> let e2 = expr_se se2 in Asttools.expr_concat e1 e2
      end
  | Slid (loc, s) -> lident_expr loc s
  | Slidv (loc, s) -> MLast.ExLid (loc, s)
  | Suid (loc, s) ->
      MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal (rename_id s)))
  | Suidv (loc, s) -> MLast.ExLong (loc, MLast.LiUid (loc, s))
  | Sint (loc, s) -> MLast.ExInt (loc, s, "")
  | Sint_l (loc, s) -> MLast.ExInt (loc, s, "l")
  | Sint_L (loc, s) -> MLast.ExInt (loc, s, "L")
  | Sint_n (loc, s) -> MLast.ExInt (loc, s, "n")
  | Sfloat (loc, s) -> MLast.ExFlo (loc, s)
  | Schar (loc, s) -> MLast.ExChr (loc, s)
  | Sstring (loc, s) -> MLast.ExStr (loc, Ploc.VaVal (loc, s))
  | Sexpr (loc, [Slid (_, "~"); se]) ->
      let s = anti_lid_or_error se in
      MLast.ExLab (loc, Ploc.VaVal [MLast.PaLid (loc, s), Ploc.VaVal None])
  | Sexpr (loc, [Slid (_, "~"); se1; se2]) ->
      let s = anti_lid_or_error se1 in
      let e = expr_se se2 in
      MLast.ExLab
        (loc, Ploc.VaVal [MLast.PaLid (loc, s), Ploc.VaVal (Some e)])
  | Sexpr (loc, [Slid (_, "?"); se1; se2]) ->
      let s = anti_lid_or_error se1 in
      let e = expr_se se2 in
      MLast.ExOlb (loc, MLast.PaLid (loc, s), Ploc.VaVal (Some e))
  | Sexpr (loc, [Slid (_, "?"); se]) ->
      let s = anti_lid_or_error se in
      MLast.ExOlb (loc, MLast.PaLid (loc, s), Ploc.VaVal None)
  | Sexpr (loc, []) -> MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "()"))
  | Sexpr (loc, Slid (_, s) :: e1 :: (_ :: _ as sel))
    when List.mem s assoc_left_parsed_op_list ->
      let rec loop e1 =
        function
          [] -> e1
        | e2 :: el -> loop (op_apply loc e1 e2 s) el
      in
      loop (expr_se e1) (List.map expr_se sel)
  | Sexpr (loc, Slid (_, s) :: (_ :: _ :: _ as sel))
    when List.mem s assoc_right_parsed_op_list ->
      let rec loop =
        function
          [] -> assert false
        | [e1] -> e1
        | e1 :: el -> let e2 = loop el in op_apply loc e1 e2 s
      in
      loop (List.map expr_se sel)
  | Sexpr (loc, Slid (_, s) :: (_ :: _ :: _ as sel))
    when List.mem s and_by_couple_op_list ->
      let rec loop =
        function
          [] | [_] -> assert false
        | [e1; e2] ->
            MLast.ExApp
              (loc, MLast.ExApp (loc, MLast.ExLid (loc, Ploc.VaVal s), e1),
               e2)
        | e1 :: (e2 :: _ :: _ as el) ->
            let a1 = op_apply loc e1 e2 s in
            let a2 = loop el in
            MLast.ExApp
              (loc, MLast.ExApp (loc, MLast.ExLid (loc, Ploc.VaVal "&&"), a1),
               a2)
      in
      loop (List.map expr_se sel)
  | Sexpr (loc, [Slid (_, "-"); se]) ->
      let e = expr_se se in
      MLast.ExApp (loc, MLast.ExLid (loc, Ploc.VaVal "-"), e)
  | Sexpr (loc, [Slid (_, "-."); se]) ->
      let e = expr_se se in
      MLast.ExApp (loc, MLast.ExLid (loc, Ploc.VaVal "-."), e)
  | Sexpr (loc, [Slid (_, "if"); se; se1]) ->
      let e = expr_se se in
      let e1 = expr_se se1 in
      MLast.ExIfe
        (loc, e, e1, MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "()")))
  | Sexpr (loc, [Slid (_, "if"); se; se1; se2]) ->
      let e = expr_se se in
      let e1 = expr_se se1 in
      let e2 = expr_se se2 in MLast.ExIfe (loc, e, e1, e2)
  | Sexpr (loc, Slid (_, "cond") :: sel) ->
      let rec loop =
        function
          [Sexpr (loc, Slid (_, "else") :: sel)] -> begin_se loc sel
        | Sexpr (loc, se1 :: sel1) :: sel ->
            let e1 = expr_se se1 in
            let e2 = begin_se loc sel1 in
            let e3 = loop sel in MLast.ExIfe (loc, e1, e2, e3)
        | [] -> MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "()"))
        | se :: _ -> error se "cond clause"
      in
      loop sel
  | Sexpr (loc, Slid (_, "while") :: se :: sel) ->
      let e = expr_se se in
      let el = anti_list_map expr_se sel in MLast.ExWhi (loc, e, el)
  | Sexpr
      (loc, Slid (_, ("for" | "fordown" as d)) :: sei :: se1 :: se2 :: sel) ->
      let i = anti_lid_or_error sei in
      let e1 = expr_se se1 in
      let e2 = expr_se se2 in
      let dir = d = "for" in
      let el = anti_list_map expr_se sel in
      MLast.ExFor (loc, MLast.PaLid (loc, i), e1, e2, Ploc.VaVal dir, el)
  | Sexpr (loc, [Slid (loc1, "lambda")]) -> MLast.ExFun (loc, Ploc.VaVal [])
  | Sexpr (loc, Slid (loc1, "lambda") :: sep :: sel) ->
      let e = begin_se loc1 sel in
      begin match ipatt_opt_se sep with
        Left p -> MLast.ExFun (loc, Ploc.VaVal [p, Ploc.VaVal None, e])
      | Right (se, sel) ->
          List.fold_right
            (fun se e ->
               let p = ipatt_se se in
               MLast.ExFun (loc, Ploc.VaVal [p, Ploc.VaVal None, e]))
            (se :: sel) e
      end
  | Sexpr (loc, Slid (_, "lambda_match") :: sel) ->
      let pel =
        match sel with
          [Sexpr (_, [Santi (loc, ("list" | "_list"), s)])] -> Ploc.VaAnt s
        | _ -> Ploc.VaVal (List.map (match_case loc) sel)
      in
      MLast.ExFun (loc, pel)
  | Sexpr (loc, Slid (_, ("let" | "letrec" as r)) :: sel) ->
      begin match sel with
        Sexpr (_, sel1) :: sel2 ->
          let r = r = "letrec" in
          let lbs = anti_list_map let_binding_se sel1 in
          let e = begin_se loc sel2 in MLast.ExLet (loc, Ploc.VaVal r, lbs, e)
      | Slid (_, n) :: Sexpr (_, sl) :: sel ->
          let n = rename_id n in
          let (pl, el) =
            List.fold_right
              (fun se (pl, el) ->
                 match se with
                   Sexpr (_, [se1; se2]) ->
                     patt_se se1 :: pl, expr_se se2 :: el
                 | se -> error se "named let")
              sl ([], [])
          in
          let e1 =
            List.fold_right
              (fun p e ->
                 MLast.ExFun (loc, Ploc.VaVal [p, Ploc.VaVal None, e]))
              pl (begin_se loc sel)
          in
          let e2 =
            List.fold_left (fun e1 e2 -> MLast.ExApp (loc, e1, e2))
              (MLast.ExLid (loc, Ploc.VaVal n)) el
          in
          MLast.ExLet
            (loc, Ploc.VaVal true,
             Ploc.VaVal [MLast.PaLid (loc, Ploc.VaVal n), e1, Ploc.VaVal []],
             e2)
      | se :: _ -> error se "let_binding"
      | _ -> error_loc loc "let_binding"
      end
  | Sexpr (loc, Slid (_, "let*") :: sel) ->
      begin match sel with
        Sexpr (_, sel1) :: sel2 ->
          List.fold_right
            (fun se ek ->
               let (p, e, _) = let_binding_se se in
               MLast.ExLet
                 (loc, Ploc.VaVal false, Ploc.VaVal [p, e, Ploc.VaVal []],
                  ek))
            sel1 (begin_se loc sel2)
      | se :: _ -> error se "let_binding"
      | _ -> error_loc loc "let_binding"
      end
  | Sexpr (loc, [Slid (_, "letmodule"); se1; se2; se3]) ->
      let s = anti_uidopt_or_error se1 in
      let me = module_expr_se se2 in
      let e = expr_se se3 in MLast.ExLmd (loc, s, me, e)
  | Sexpr (loc, [Slid (_, "letopen"); se1; se3]) ->
      let s = anti_uid_or_error se1 in
      let e = expr_se se3 in
      MLast.ExLop (loc, Ploc.VaVal false, MLast.MeUid (loc, s), e)
  | Sexpr (loc, Slid (_, "match") :: se :: sel) ->
      let e = expr_se se in
      let pel =
        match sel with
          [Sexpr (_, [Santi (_, ("list" | "_list"), s)])] -> Ploc.VaAnt s
        | _ -> Ploc.VaVal (List.map (match_case loc) sel)
      in
      MLast.ExMat (loc, e, pel)
  | Sexpr (loc, Slid (_, "parser") :: sel) ->
      let (po, sel) =
        match sel with
          (Slid (_, _) as se) :: sel -> Some (patt_se se), sel
        | sel -> None, sel
      in
      let pcl = List.map parser_case_se sel in Exparser.cparser loc (po, pcl)
  | Sexpr (loc, Slid (_, "match_with_parser") :: se :: sel) ->
      let e = expr_se se in
      let (po, sel) =
        match sel with
          (Slid (_, _) as se) :: sel -> Some (patt_se se), sel
        | sel -> None, sel
      in
      let pcl = List.map parser_case_se sel in
      Exparser.cparser_match loc e (po, pcl)
  | Sexpr (loc, Slid (_, "try") :: se :: sel) ->
      let e = expr_se se in
      let pel =
        match sel with
          [Sexpr (_, [Santi (_, ("list" | "_list"), s)])] -> Ploc.VaAnt s
        | _ -> Ploc.VaVal (List.map (match_case loc) sel)
      in
      MLast.ExTry (loc, e, pel)
  | Sexpr (loc, Slid (_, "begin") :: sel) ->
      let el = anti_list_map expr_se sel in MLast.ExSeq (loc, el)
  | Sexpr (loc, [Slid (_, ":="); se1; se2]) ->
      let e1 = expr_se se1 in
      let e2 = expr_se se2 in MLast.ExAss (loc, e1, e2)
  | Sarr (loc, sel) ->
      let el = Pcaml.vala_map (List.map expr_se) sel in MLast.ExArr (loc, el)
  | Sexpr (loc, Slid (_, "values") :: sel) ->
      let el = anti_list_map expr_se sel in MLast.ExTup (loc, el)
  | Srec (loc, Slid (_, "with") :: se :: sel) ->
      let e = expr_se se
      and lel = anti_list_map (label_expr_se loc) sel in
      MLast.ExRec (loc, lel, Some e)
  | Srec (loc, sel) ->
      let lel = anti_list_map (label_expr_se loc) sel in
      MLast.ExRec (loc, lel, None)
  | Sexpr (loc, [Slid (_, ":"); se1; se2]) ->
      let e = expr_se se1 in let t = ctyp_se se2 in MLast.ExTyc (loc, e, t)
  | Sexpr (loc, [se]) ->
      let e = expr_se se in
      MLast.ExApp
        (loc, e, MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "()")))
  | Sexpr (loc, [Slid (_, "assert"); se]) ->
      let e = expr_se se in MLast.ExAsr (loc, e)
  | Sexpr (loc, [Slid (_, "lazy"); se]) ->
      let e = expr_se se in MLast.ExLaz (loc, e)
  | Sexpr (loc, [Slid (_, "new"); se]) ->
      begin match class_longident_se se with
        None, id -> MLast.ExNew (loc, Ploc.VaVal (None, Ploc.VaVal id))
      | Some li, id ->
          MLast.ExNew (loc, Ploc.VaVal (Some (Ploc.VaVal li), Ploc.VaVal id))
      end
  | Sexpr (loc, [Slid (_, "`"); Suid (_, s)]) ->
      MLast.ExVrn (loc, Ploc.VaVal s)
  | Sexpr (loc, [Slid (_, "send"); se; Slid (_, s)]) ->
      let e = expr_se se in MLast.ExSnd (loc, e, Ploc.VaVal s)
  | Sexpr (loc, se :: sel) ->
      List.fold_left
        (fun e se -> let e1 = expr_se se in MLast.ExApp (loc, e, e1))
        (expr_se se) sel
  | Slist (loc, sel) ->
      let rec loop =
        function
          [] -> MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "[]"))
        | [se1; Slid (_, "."); se2] ->
            let e = expr_se se1 in
            let el = expr_se se2 in
            MLast.ExApp
              (loc,
               MLast.ExApp
                 (loc, MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "::")),
                  e),
               el)
        | se :: sel ->
            let e = expr_se se in
            let el = loop sel in
            MLast.ExApp
              (loc,
               MLast.ExApp
                 (loc, MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "::")),
                  e),
               el)
      in
      loop sel
  | Squot (loc, typ, txt) -> Pcaml.handle_expr_quotation loc (typ, txt)
  | Santi (loc, "", s) -> MLast.ExXtr (loc, s, None)
  | Santi (loc, _, s) -> error_loc loc "expr"
and begin_se loc =
  function
    [] -> MLast.ExLong (loc, MLast.LiUid (loc, Ploc.VaVal "()"))
  | [se] -> expr_se se
  | sel ->
      let el = List.map expr_se sel in
      let loc = Ploc.encl (loc_of_sexpr (List.hd sel)) loc in
      MLast.ExSeq (loc, Ploc.VaVal el)
and let_binding_se =
  function
    Sexpr (loc, se :: sel) ->
      let e = begin_se loc sel in
      begin match ipatt_opt_se se with
        Left p -> p, e, Ploc.VaVal []
      | Right _ -> fun_binding_se se e
      end
  | se -> error se "let_binding"
and fun_binding_se se e =
  match se with
    Sexpr (_, Slid (_, "values") :: _) -> ipatt_se se, e, Ploc.VaVal []
  | Sexpr (_, [Slid (_, ":"); _; _]) -> ipatt_se se, e, Ploc.VaVal []
  | Sexpr (_, se1 :: sel) ->
      begin match ipatt_opt_se se1 with
        Left p ->
          let e =
            List.fold_right
              (fun se e ->
                 let loc =
                   Ploc.encl (loc_of_sexpr se) (MLast.loc_of_expr e)
                 in
                 let p = ipatt_se se in
                 MLast.ExFun (loc, Ploc.VaVal [p, Ploc.VaVal None, e]))
              sel e
          in
          p, e, Ploc.VaVal []
      | Right _ -> ipatt_se se, e, Ploc.VaVal []
      end
  | _ -> ipatt_se se, e, Ploc.VaVal []
and match_case loc =
  function
    Sexpr (loc, Sexpr (_, [Slid (_, "when"); se; sew]) :: sel) ->
      patt_se se, Ploc.VaVal (Some (expr_se sew)), begin_se loc sel
  | Sexpr (loc, se :: sel) -> patt_se se, Ploc.VaVal None, begin_se loc sel
  | se -> error se "match_case"
and label_expr_se loc =
  function
    Sexpr (_, [se1; se2]) -> patt_se se1, expr_se se2
  | se -> error se "label_expr"
and label_patt_se loc =
  function
    Sexpr (_, [se1; se2]) -> patt_se se1, patt_se se2
  | se -> error se "label_patt"
and label_ipatt_se loc =
  function
    Sexpr (_, [se1; se2]) -> ipatt_se se1, ipatt_se se2
  | se -> error se "label_ipatt"
and parser_case_se =
  function
    Sexpr (_, [Sexpr (_, sel); se1; se2]) ->
      let sp = stream_patt_se sel in
      let po = Some (ipatt_se se1) in let e = expr_se se2 in sp, po, e
  | Sexpr (_, [Sexpr (_, sel); se]) ->
      let sp = stream_patt_se sel in let e = expr_se se in sp, None, e
  | se -> error se "parser_case"
and stream_patt_se =
  function
    se :: sel ->
      let spc = stream_patt_comp_se se in
      let sp = stream_patt_kont_se sel in (spc, SpoNoth) :: sp
  | [] -> []
and stream_patt_kont_se =
  function
    se :: Slid (_, "!") :: sel ->
      let spc = stream_patt_comp_se se in
      let sp = stream_patt_kont_se sel in (spc, SpoBang) :: sp
  | se1 :: Slid (_, "?") :: se2 :: sel ->
      let spc = stream_patt_comp_se se1 in
      let e = expr_se se2 in
      let sp = stream_patt_kont_se sel in (spc, SpoQues e) :: sp
  | se :: sel ->
      let spc = stream_patt_comp_se se in
      let sp = stream_patt_kont_se sel in (spc, SpoNoth) :: sp
  | [] -> []
and stream_patt_comp_se =
  function
    Sexpr (loc, [Slid (_, "`"); se]) ->
      SpTrm (loc, patt_se se, Ploc.VaVal None)
  | Sexpr (loc, [Slid (_, "`"); se1; se2]) ->
      let e = expr_se se2 in SpTrm (loc, patt_se se1, Ploc.VaVal (Some e))
  | Sexpr (loc, [Slid (_, "let"); se1; se2]) ->
      SpLet (loc, ipatt_se se1, expr_se se2)
  | Sexpr (loc, [se1; se2]) -> SpNtr (loc, patt_se se1, expr_se se2)
  | se -> SpStr (loc_of_sexpr se, patt_se se)
and patt_se =
  function
    Sacc (loc, se1, se2) ->
      let me1 = longid_se se1 in
      begin match patt_se se2 with
        MLast.PaPfx (_, me2, MLast.PaLid (_, Ploc.VaVal lid)) ->
          let me = longid_concat me1 me2 in
          MLast.PaPfx (loc, me, MLast.PaLid (loc, Ploc.VaVal lid))
      | p -> MLast.PaPfx (loc, me1, p)
      end
  | Slid (loc, "_") -> MLast.PaAny loc
  | Slid (loc, s) -> MLast.PaLid (loc, Ploc.VaVal (rename_id s))
  | Slidv (loc, s) -> MLast.PaLid (loc, s)
  | Suid (loc, s) ->
      MLast.PaLong
        (loc, MLast.LiUid (loc, Ploc.VaVal (rename_id s)), Ploc.VaVal [])
  | Suidv (loc, s) -> MLast.PaLong (loc, MLast.LiUid (loc, s), Ploc.VaVal [])
  | Sint (loc, s) -> MLast.PaInt (loc, s, "")
  | Sint_l (loc, s) -> MLast.PaInt (loc, s, "l")
  | Sint_L (loc, s) -> MLast.PaInt (loc, s, "L")
  | Sint_n (loc, s) -> MLast.PaInt (loc, s, "n")
  | Sfloat (loc, s) -> MLast.PaFlo (loc, s)
  | Schar (loc, s) -> MLast.PaChr (loc, s)
  | Sstring (loc, s) -> MLast.PaStr (loc, s)
  | Sexpr (loc, [Slid (_, "~"); se]) ->
      let s = anti_lid_or_error se in
      MLast.PaLab (loc, Ploc.VaVal [MLast.PaLid (loc, s), Ploc.VaVal None])
  | Sexpr (loc, [Slid (_, "~"); se1; se2]) ->
      let s = anti_lid_or_error se1
      and p = patt_se se2 in
      MLast.PaLab
        (loc, Ploc.VaVal [MLast.PaLid (loc, s), Ploc.VaVal (Some p)])
  | Sexpr (loc, [Slid (_, "?"); se]) ->
      begin match se with
        Sexpr (_, [se1; se2]) ->
          let s = anti_lid_or_error se1
          and e = expr_se se2 in
          MLast.PaOlb (loc, MLast.PaLid (loc, s), Ploc.VaVal (Some e))
      | se ->
          let s = anti_lid_or_error se in
          MLast.PaOlb (loc, MLast.PaLid (loc, s), Ploc.VaVal None)
      end
  | Sexpr (loc, [Slid (_, "?"); se1; se2]) ->
      let e = expr_se se2 in
      begin match se1 with
        Sexpr (_, [se1; se2]) ->
          let s = anti_lid_or_error se1
          and p = patt_se se2 in
          MLast.PaOlb
            (loc, MLast.PaLid (loc, s),
             Ploc.VaVal (Some (MLast.ExOlb (loc, p, Ploc.VaVal (Some e)))))
      | se ->
          let s = anti_lid_or_error se in
          MLast.PaOlb (loc, MLast.PaLid (loc, s), Ploc.VaVal (Some e))
      end
  | Srec (loc, sel) ->
      let lpl = anti_list_map (label_patt_se loc) sel in
      MLast.PaRec (loc, lpl)
  | Sexpr (loc, [Slid (_, ":"); se1; se2]) ->
      let p = patt_se se1 in let t = ctyp_se se2 in MLast.PaTyc (loc, p, t)
  | Sexpr (loc, Slid (_, "or") :: se :: sel) ->
      List.fold_left
        (fun p se -> let p1 = patt_se se in MLast.PaOrp (loc, p, p1))
        (patt_se se) sel
  | Sexpr (loc, [Slid (_, "range"); se1; se2]) ->
      let p1 = patt_se se1 in
      let p2 = patt_se se2 in MLast.PaRng (loc, p1, p2)
  | Sarr (loc, sel) ->
      let pl = Pcaml.vala_map (List.map patt_se) sel in MLast.PaArr (loc, pl)
  | Sexpr (loc, Slid (_, "values") :: sel) ->
      let pl = anti_list_map patt_se sel in MLast.PaTup (loc, pl)
  | Sexpr (loc, [Slid (_, "as"); se1; se2]) ->
      let p1 = patt_se se1 in
      let p2 = patt_se se2 in MLast.PaAli (loc, p1, p2)
  | Sexpr (loc, [Slid (_, "`"); Suid (_, s)]) ->
      MLast.PaVrn (loc, Ploc.VaVal s)
  | Sexpr (loc, se :: sel) ->
      List.fold_left
        (fun p se -> let p1 = patt_se se in MLast.PaApp (loc, p, p1))
        (patt_se se) sel
  | Sexpr (loc, []) ->
      MLast.PaLong (loc, MLast.LiUid (loc, Ploc.VaVal "()"), Ploc.VaVal [])
  | Slist (loc, sel) ->
      let rec loop =
        function
          [] ->
            MLast.PaLong
              (loc, MLast.LiUid (loc, Ploc.VaVal "[]"), Ploc.VaVal [])
        | [se1; Slid (_, "."); se2] ->
            let p = patt_se se1 in
            let pl = patt_se se2 in
            MLast.PaApp
              (loc,
               MLast.PaApp
                 (loc,
                  MLast.PaLong
                    (loc, MLast.LiUid (loc, Ploc.VaVal "::"), Ploc.VaVal []),
                  p),
               pl)
        | se :: sel ->
            let p = patt_se se in
            let pl = loop sel in
            MLast.PaApp
              (loc,
               MLast.PaApp
                 (loc,
                  MLast.PaLong
                    (loc, MLast.LiUid (loc, Ploc.VaVal "::"), Ploc.VaVal []),
                  p),
               pl)
      in
      loop sel
  | Squot (loc, typ, txt) -> Pcaml.handle_patt_quotation loc (typ, txt)
  | Santi (loc, "", s) -> MLast.PaXtr (loc, s, None)
  | Santi (loc, _, s) -> error_loc loc "patt"
and ipatt_se se =
  match ipatt_opt_se se with
    Left p -> p
  | Right _ -> patt_se se
and ipatt_opt_se =
  function
    Slid (loc, "_") -> Left (MLast.PaAny loc)
  | Slid (loc, s) -> Left (MLast.PaLid (loc, Ploc.VaVal (rename_id s)))
  | Sexpr (loc, [Slid (_, "~"); Slid (_, s)]) ->
      Left
        (MLast.PaLab
           (loc,
            Ploc.VaVal [MLast.PaLid (loc, Ploc.VaVal s), Ploc.VaVal None]))
  | Sexpr (loc, [Slid (_, "~"); Slid (_, s); se]) ->
      let p = patt_se se in
      Left
        (MLast.PaLab
           (loc,
            Ploc.VaVal
              [MLast.PaLid (loc, Ploc.VaVal s), Ploc.VaVal (Some p)]))
  | Sexpr (loc, [Slid (_, "?"); se]) ->
      begin match se with
        Sexpr (_, [se1; Slid (_, p)]) ->
          let s = anti_lid_or_error se1 in
          Left
            (MLast.PaOlb
               (loc, MLast.PaLid (loc, s),
                Ploc.VaVal (Some (MLast.ExLid (loc, Ploc.VaVal p)))))
      | se ->
          let s = anti_lid_or_error se in
          Left (MLast.PaOlb (loc, MLast.PaLid (loc, s), Ploc.VaVal None))
      end
  | Sexpr (loc, [Slid (_, "?"); se1; se2]) ->
      let e = expr_se se2 in
      begin match se1 with
        Sexpr (_, [se1; Slid (_, p)]) ->
          let s = anti_lid_or_error se1 in
          Left
            (MLast.PaOlb
               (loc, MLast.PaLid (loc, s),
                Ploc.VaVal
                  (Some
                     (MLast.ExOlb
                        (loc, MLast.PaLid (loc, Ploc.VaVal p),
                         Ploc.VaVal (Some e))))))
      | se ->
          let s = anti_lid_or_error se in
          Left (MLast.PaOlb (loc, MLast.PaLid (loc, s), Ploc.VaVal (Some e)))
      end
  | Sexpr (loc, [Slid (_, ":"); se1; se2]) ->
      let p = ipatt_se se1 in
      let t = ctyp_se se2 in Left (MLast.PaTyc (loc, p, t))
  | Sexpr (loc, [Slid (_, "as"); se1; se2]) ->
      let p1 = ipatt_se se1 in
      let p2 = ipatt_se se2 in Left (MLast.PaAli (loc, p1, p2))
  | Sexpr (loc, Slid (_, "values") :: sel) ->
      let pl = List.map ipatt_se sel in
      Left (MLast.PaTup (loc, Ploc.VaVal pl))
  | Srec (loc, sel) ->
      let lpl = List.map (label_ipatt_se loc) sel in
      Left (MLast.PaRec (loc, Ploc.VaVal lpl))
  | Sexpr (loc, []) ->
      Left
        (MLast.PaLong
           (loc, MLast.LiUid (loc, Ploc.VaVal "()"), Ploc.VaVal []))
  | Sexpr (loc, se :: sel) -> Right (se, sel)
  | se -> error se "ipatt"
and type_declaration_se =
  function
    Sexpr (loc, [se1; se2]) ->
      let (n1, loc1, tpl) =
        match se1 with
          Sexpr (_, Slid (loc, n) :: sel) ->
            rename_id n, loc, List.map type_param_se sel
        | Slid (loc, n) -> rename_id n, loc, []
        | se -> error se "type declaration"
      in
      let n = loc1, Ploc.VaVal n1 in
      {MLast.tdIsDecl = Ploc.VaVal true; MLast.tdNam = Ploc.VaVal n;
       MLast.tdPrm = Ploc.VaVal tpl; MLast.tdPrv = Ploc.VaVal false;
       MLast.tdDef = ctyp_se se2; MLast.tdCon = Ploc.VaVal [];
       MLast.tdAttributes = Ploc.VaVal []}
  | se -> error se "type_decl"
and type_declaration_list_se =
  function
    se1 :: se2 :: sel ->
      let (n1, loc1, tpl) =
        match se1 with
          Sexpr (_, Slid (loc, n) :: sel) ->
            rename_id n, loc, List.map type_param_se sel
        | Slid (loc, n) -> rename_id n, loc, []
        | se -> error se "type declaration"
      in
      let n = loc1, Ploc.VaVal n1 in
      let td =
        {MLast.tdIsDecl = Ploc.VaVal true; MLast.tdNam = Ploc.VaVal n;
         MLast.tdPrm = Ploc.VaVal tpl; MLast.tdPrv = Ploc.VaVal false;
         MLast.tdDef = ctyp_se se2; MLast.tdCon = Ploc.VaVal [];
         MLast.tdAttributes = Ploc.VaVal []}
      in
      td :: type_declaration_list_se sel
  | [] -> []
  | se :: _ -> error se "type_decl"
and type_param_se se =
  match se with
    Slid (_, s) when String.length s >= 2 && s.[0] = '\'' ->
      let s = String.sub s 1 (String.length s - 1) in
      Ploc.VaVal (Some s), (None, false)
  | Slid (_, s) when String.length s >= 3 && s.[1] = '\'' ->
      let vara =
        if s.[0] = '+' then Some true, false
        else if s.[0] = '-' then Some false, false
        else error se "type_param"
      and s = String.sub s 2 (String.length s - 2) in
      Ploc.VaVal (Some s), vara
  | se -> error se "type_param"
and ctyp_se =
  function
    Sexpr (loc, Slid (_, "sum") :: sel) ->
      let cdl = anti_list_map constructor_declaration_se sel in
      MLast.TySum (loc, cdl)
  | Sexpr (loc, Slid (_, "variants") :: sel) ->
      let cdl = anti_list_map variant_declaration_se sel in
      MLast.TyVrn (loc, cdl, None)
  | Sexpr (loc, Slid (_, "variantsless") :: sel) ->
      let cdl = anti_list_map variant_declaration_se sel in
      MLast.TyVrn (loc, cdl, Some (Some (Ploc.VaVal [])))
  | Sexpr (loc, Slid (_, "variantsgreater") :: sel) ->
      let cdl = anti_list_map variant_declaration_se sel in
      MLast.TyVrn (loc, cdl, Some None)
  | Srec (loc, sel) ->
      let ldl = anti_list_map label_declaration_se sel in
      MLast.TyRec (loc, ldl)
  | Sexpr (loc, Slid (_, "->") :: (_ :: _ :: _ as sel)) ->
      let rec loop =
        function
          [] -> assert false
        | [se] -> ctyp_se se
        | se :: sel ->
            let t1 = ctyp_se se in
            let loc = Ploc.encl (loc_of_sexpr se) loc in
            let t2 = loop sel in MLast.TyArr (loc, t1, t2)
      in
      loop sel
  | Sexpr (loc, [Slid (_, "as"); se1; se2]) ->
      let t1 = ctyp_se se1 in
      let t2 = ctyp_se se2 in MLast.TyAli (loc, t1, t2)
  | Sexpr (loc, Slid (_, "*") :: sel) ->
      let tl = anti_list_map ctyp_se sel in MLast.TyTup (loc, tl)
  | Sexpr (loc, [Slid (_, "=="); se1; se2]) ->
      let t1 = ctyp_se se1 in
      let t2 = ctyp_se se2 in MLast.TyMan (loc, t1, Ploc.VaVal false, t2)
  | Sexpr (loc, [Slid (_, "?"); se1; se2]) ->
      let s = anti_lid_or_error se1
      and t = ctyp_se se2 in
      MLast.TyOlb (loc, s, t)
  | Sexpr (loc, [Slid (_, "~"); se1; se2]) ->
      let s = anti_lid_or_error se1
      and t = ctyp_se se2 in
      MLast.TyLab (loc, s, t)
  | Sexpr (loc, Slid (_, "object") :: sel) ->
      let fl = object_field_list_se sel in
      MLast.TyObj (loc, fl, Ploc.VaVal false)
  | Sexpr (loc, Slid (_, "objectvar") :: sel) ->
      let fl = object_field_list_se sel in
      MLast.TyObj (loc, fl, Ploc.VaVal true)
  | Sexpr (loc, se :: sel) ->
      List.fold_left
        (fun t se -> let t2 = ctyp_se se in MLast.TyApp (loc, t, t2))
        (ctyp_se se) sel
  | Sacc (loc, se1, se2) ->
      let me1 = longid_se se1 in
      begin match ctyp_se se2 with
        MLast.TyAcc (_, me2, Ploc.VaVal lid) ->
          let me = longid_concat me1 me2 in
          MLast.TyAcc (loc, me, Ploc.VaVal lid)
      | MLast.TyLid (_, Ploc.VaVal lid) ->
          MLast.TyAcc (loc, me1, Ploc.VaVal lid)
      | _ -> failwith "pa_schemer: only TyAcc and TyLid allowed here"
      end
  | Slid (loc, "_") -> MLast.TyAny loc
  | Slid (loc, s) ->
      if s.[0] = '\'' then
        let s = String.sub s 1 (String.length s - 1) in
        MLast.TyQuo (loc, Ploc.VaVal s)
      else MLast.TyLid (loc, Ploc.VaVal (rename_id s))
  | Slidv (loc, s) -> MLast.TyLid (loc, s)
  | Suid (loc, s) as se -> error se "ctyp_se: UID not allowed here"
  | Suidv (loc, s) as se -> error se "ctyp_se: UIDv not allowed here"
  | Santi (loc, "", s) -> MLast.TyXtr (loc, s, None)
  | se -> error se "ctyp"
and object_field_list_se sel =
  anti_list_map
    (function
       Sexpr (loc, [Slid (_, s); se]) ->
         let t = ctyp_se se in Some s, t, Ploc.VaVal []
     | se -> error_loc (loc_of_sexpr se) "object field")
    sel
and constructor_declaration_se =
  function
    Sexpr (loc, Suid (_, ci) :: sel) ->
      loc, Ploc.VaVal (rename_id ci), Ploc.VaVal [],
      Ploc.VaVal (List.map ctyp_se sel), Ploc.VaVal None, Ploc.VaVal []
  | se -> error se "constructor_declaration"
and variant_declaration_se =
  function
    Sexpr (loc, [Slid (_, "`"); Suid (_, s)]) ->
      MLast.PvTag
        (loc, Ploc.VaVal s, Ploc.VaVal true, Ploc.VaVal [], Ploc.VaVal [])
  | Sexpr (loc, Slid (_, "`") :: Suid (_, s) :: sel) ->
      let (a, sel) =
        match sel with
          Slid (_, "&") :: sel -> true, sel
        | sel -> false, sel
      in
      let tl = List.map ctyp_se sel in
      MLast.PvTag
        (loc, Ploc.VaVal s, Ploc.VaVal a, Ploc.VaVal tl, Ploc.VaVal [])
  | se ->
      let t = ctyp_se se in let loc = loc_of_sexpr se in MLast.PvInh (loc, t)
and label_declaration_se =
  function
    Sexpr (loc, [Slid (_, lab); Slid (_, "mutable"); se]) ->
      loc, rename_id lab, true, ctyp_se se, Ploc.VaVal []
  | Sexpr (loc, [Slid (_, lab); se]) ->
      loc, rename_id lab, false, ctyp_se se, Ploc.VaVal []
  | se -> error se "label_declaration"
and class_sig_item_se =
  function
    Sexpr (loc, [Slid (_, "method"); Slid (_, n); se]) ->
      let t = ctyp_se se in
      MLast.CgMth (loc, Ploc.VaVal false, Ploc.VaVal n, t, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "value"); Slid (_, "mutable"); Slid (_, n); se]) ->
      let t = ctyp_se se in
      MLast.CgVal
        (loc, Ploc.VaVal true, Ploc.VaVal false, Ploc.VaVal n, t,
         Ploc.VaVal [])
  | se -> error se "class_sig_item"
and class_str_item_se =
  function
    Sexpr (loc, [Slid (_, "inherit"); se; Slid (_, s)]) ->
      let ce = class_expr_se se in
      MLast.CrInh
        (loc, Ploc.VaVal false, ce, Ploc.VaVal (Some s), Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "inherit"); se]) ->
      let ce = class_expr_se se in
      MLast.CrInh (loc, Ploc.VaVal false, ce, Ploc.VaVal None, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "initializer"); se]) ->
      let e = expr_se se in MLast.CrIni (loc, e, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "method"); Slid (_, "virtual"); Slid (_, n); se]) ->
      let t = ctyp_se se in
      MLast.CrVir (loc, Ploc.VaVal false, Ploc.VaVal n, t, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "method"); Slid (_, "private"); Slid (_, n); se]) ->
      let e = expr_se se in
      MLast.CrMth
        (loc, Ploc.VaVal false, Ploc.VaVal true, Ploc.VaVal n,
         Ploc.VaVal None, e, Ploc.VaVal [])
  | Sexpr
      (loc,
       [Slid (_, "method"); Slid (_, "private");
        Sexpr (_, Slid (_, n) :: sel); se]) ->
      let e =
        List.fold_right
          (fun se e ->
             let p = patt_se se in
             MLast.ExFun (loc, Ploc.VaVal [p, Ploc.VaVal None, e]))
          sel (expr_se se)
      in
      MLast.CrMth
        (loc, Ploc.VaVal false, Ploc.VaVal true, Ploc.VaVal n,
         Ploc.VaVal None, e, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "method"); Slid (_, n); se]) ->
      let e = expr_se se in
      MLast.CrMth
        (loc, Ploc.VaVal false, Ploc.VaVal false, Ploc.VaVal n,
         Ploc.VaVal None, e, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "method"); Sexpr (_, Slid (_, n) :: sel); se]) ->
      let e =
        List.fold_right
          (fun se e ->
             let p = patt_se se in
             MLast.ExFun (loc, Ploc.VaVal [p, Ploc.VaVal None, e]))
          sel (expr_se se)
      in
      MLast.CrMth
        (loc, Ploc.VaVal false, Ploc.VaVal false, Ploc.VaVal n,
         Ploc.VaVal None, e, Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "value"); Slid (_, "mutable"); Slid (_, n); se]) ->
      let e = expr_se se in
      MLast.CrVal
        (loc, Ploc.VaVal false, Ploc.VaVal true, Ploc.VaVal n, e,
         Ploc.VaVal [])
  | Sexpr (loc, [Slid (_, "value"); Slid (_, n); se]) ->
      let e = expr_se se in
      MLast.CrVal
        (loc, Ploc.VaVal false, Ploc.VaVal false, Ploc.VaVal n, e,
         Ploc.VaVal [])
  | se -> error se "class_str_item"
and class_type_se =
  function
    Sexpr (loc, Slid (_, "->") :: se :: sel) ->
      let rec loop =
        function
          [] -> assert false
        | [se] -> class_type_se se
        | se :: sel ->
            let t = ctyp_se se in
            let ct = loop sel in MLast.CtFun (loc, t, ct)
      in
      loop (se :: sel)
  | Sexpr (loc, Slid (_, "object") :: sel) ->
      let csl = List.map class_sig_item_se sel in
      MLast.CtSig (loc, Ploc.VaVal None, Ploc.VaVal csl)
  | se -> error se "class_type_se"
and class_expr_se =
  function
    Sexpr (loc, [Slid (_, "let"); Sexpr (_, sel); se]) ->
      let lbl = anti_list_map let_binding_se sel in
      let ce = class_expr_se se in
      MLast.CeLet (loc, Ploc.VaVal false, lbl, ce)
  | Sexpr (loc, [Slid (_, "lambda"); se1; se2]) ->
      let ce = class_expr_se se2 in
      begin match ipatt_opt_se se1 with
        Left p -> MLast.CeFun (loc, p, ce)
      | Right (se, sel) ->
          List.fold_right
            (fun se ce -> let p = ipatt_se se in MLast.CeFun (loc, p, ce))
            (se :: sel) ce
      end
  | Sexpr (loc, Slid (_, "object") :: se :: sel) ->
      let p =
        match se with
          Sexpr (_, []) -> None
        | se -> Some (patt_se se)
      in
      let csl = List.map class_str_item_se sel in
      MLast.CeStr (loc, Ploc.VaVal p, Ploc.VaVal csl)
  | Sexpr (loc, se :: sel) ->
      let rec loop ce =
        function
          se :: sel ->
            let e = expr_se se in loop (MLast.CeApp (loc, ce, e)) sel
        | [] -> ce
      in
      loop (class_expr_se se) sel
  | se ->
      let loc = loc_of_sexpr se in
      match class_longident_se se with
        None, id ->
          MLast.CeCon (loc, Ploc.VaVal (None, Ploc.VaVal id), Ploc.VaVal [])
      | Some li, id ->
          MLast.CeCon
            (loc, Ploc.VaVal (Some (Ploc.VaVal li), Ploc.VaVal id),
             Ploc.VaVal [])

let directive_se =
  function
    Sexpr (_, [Slid (_, s)]) -> s, None
  | Sexpr (_, [Slid (_, s); se]) -> let e = expr_se se in s, Some e
  | se -> error se "directive"

(* Parser *)

let _ = Pcaml.syntax_name := "Scheme"
let _ = Pcaml.no_constructors_arity := false

let _ =
  Grammar.Unsafe.gram_reinit gram (lexer_gmake ());
  Grammar.Unsafe.clear_entry interf;
  Grammar.Unsafe.clear_entry implem;
  Grammar.Unsafe.clear_entry top_phrase;
  Grammar.Unsafe.clear_entry use_file;
  Grammar.Unsafe.clear_entry expr;
  Grammar.Unsafe.clear_entry patt;
  Grammar.Unsafe.clear_entry ctyp;
  Grammar.Unsafe.clear_entry str_item;
  Grammar.Unsafe.clear_entry sig_item;
  Grammar.Unsafe.clear_entry module_expr;
  Grammar.Unsafe.clear_entry module_type;
  Grammar.Unsafe.clear_entry with_constr;
  Grammar.Unsafe.clear_entry let_binding;
  Grammar.Unsafe.clear_entry type_decl;
  Grammar.Unsafe.clear_entry class_type;
  Grammar.Unsafe.clear_entry class_expr;
  Grammar.Unsafe.clear_entry class_sig_item;
  Grammar.Unsafe.clear_entry class_str_item

let _ = Pcaml.(set_ast_parse transduce_interf (Grammar.Entry.parse interf))
let _ = Pcaml.(set_ast_parse transduce_implem (Grammar.Entry.parse implem))
let _ =
  Pcaml.(set_ast_parse transduce_top_phrase (Grammar.Entry.parse top_phrase))
let _ =
  Pcaml.(set_ast_parse transduce_use_file (Grammar.Entry.parse use_file))

let sexpr = Grammar.Entry.create gram "sexpr"

let _ =
  Grammar.safe_extend
    (let _ = (implem : 'implem Grammar.Entry.e)
     and _ = (interf : 'interf Grammar.Entry.e)
     and _ = (top_phrase : 'top_phrase Grammar.Entry.e)
     and _ = (use_file : 'use_file Grammar.Entry.e)
     and _ = (expr : 'expr Grammar.Entry.e)
     and _ = (patt : 'patt Grammar.Entry.e)
     and _ = (ctyp : 'ctyp Grammar.Entry.e)
     and _ = (str_item : 'str_item Grammar.Entry.e)
     and _ = (sig_item : 'sig_item Grammar.Entry.e)
     and _ = (module_expr : 'module_expr Grammar.Entry.e)
     and _ = (module_type : 'module_type Grammar.Entry.e)
     and _ = (with_constr : 'with_constr Grammar.Entry.e)
     and _ = (sexpr : 'sexpr Grammar.Entry.e) in
     let grammar_entry_create s =
       Grammar.create_local_entry (Grammar.of_entry implem) s
     in
     let pa_extend_keyword : 'pa_extend_keyword Grammar.Entry.e =
       grammar_entry_create "pa_extend_keyword"
     in
     [Grammar.extension (implem : 'implem Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("EOI", "")),
             "194fe98d", (fun _ (loc : Ploc.t) -> ([], Some loc : 'implem)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next Grammar.r_stop
                  (Grammar.s_nterm (str_item : 'str_item Grammar.Entry.e)))
               Grammar.s_self,
             "194fe98d",
             (fun (x : 'implem) (si : 'str_item) (loc : Ploc.t) ->
                (let (sil, stopped) = x in
                 let loc = MLast.loc_of_str_item si in
                 (si, loc) :: sil, stopped :
                 'implem)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "#")))
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) _ (loc : Ploc.t) ->
                (let (n, dp) = directive_se se in
                 [MLast.StDir (loc, Ploc.VaVal n, Ploc.VaVal dp), loc], None :
                 'implem)))]];
      Grammar.extension (interf : 'interf Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("EOI", "")),
             "194fe98d", (fun _ (loc : Ploc.t) -> ([], Some loc : 'interf)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next Grammar.r_stop
                  (Grammar.s_nterm (sig_item : 'sig_item Grammar.Entry.e)))
               Grammar.s_self,
             "194fe98d",
             (fun (x : 'interf) (si : 'sig_item) (loc : Ploc.t) ->
                (let (sil, stopped) = x in
                 let loc = MLast.loc_of_sig_item si in
                 (si, loc) :: sil, stopped :
                 'interf)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "#")))
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) _ (loc : Ploc.t) ->
                (let (n, dp) = directive_se se in
                 [MLast.SgDir (loc, Ploc.VaVal n, Ploc.VaVal dp), loc], None :
                 'interf)))]];
      Grammar.extension (top_phrase : 'top_phrase Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("EOI", "")),
             "194fe98d", (fun _ (loc : Ploc.t) -> (None : 'top_phrase)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) ->
                (Some (str_item_se se) : 'top_phrase)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "#")))
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) _ (loc : Ploc.t) ->
                (let (n, dp) = directive_se se in
                 Some (MLast.StDir (loc, Ploc.VaVal n, Ploc.VaVal dp)) :
                 'top_phrase)))]];
      Grammar.extension (use_file : 'use_file Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("EOI", "")),
             "194fe98d", (fun _ (loc : Ploc.t) -> ([], false : 'use_file)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next Grammar.r_stop
                  (Grammar.s_nterm (str_item : 'str_item Grammar.Entry.e)))
               Grammar.s_self,
             "194fe98d",
             (fun (x : 'use_file) (si : 'str_item) (loc : Ploc.t) ->
                (let (sil, stopped) = x in si :: sil, stopped : 'use_file)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "#")))
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) _ (loc : Ploc.t) ->
                (let (n, dp) = directive_se se in
                 [MLast.StDir (loc, Ploc.VaVal n, Ploc.VaVal dp)], true :
                 'use_file)))]];
      Grammar.extension (expr : 'expr Grammar.Entry.e) None
        [Some "top", None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) -> (expr_se se : 'expr)))]];
      Grammar.extension (patt : 'patt Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) -> (patt_se se : 'patt)))]];
      Grammar.extension (ctyp : 'ctyp Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) -> (ctyp_se se : 'ctyp)))]];
      Grammar.extension (str_item : 'str_item Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (expr : 'expr Grammar.Entry.e)),
             "194fe98d",
             (fun (e : 'expr) (loc : Ploc.t) ->
                (MLast.StExp (loc, e, Ploc.VaVal []) : 'str_item)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) ->
                (str_item_se se : 'str_item)))]];
      Grammar.extension (sig_item : 'sig_item Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) ->
                (sig_item_se se : 'sig_item)))]];
      Grammar.extension (module_expr : 'module_expr Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) ->
                (module_expr_se se : 'module_expr)))]];
      Grammar.extension (module_type : 'module_type Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) ->
                (module_type_se se : 'module_type)))]];
      Grammar.extension (with_constr : 'with_constr Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)),
             "194fe98d",
             (fun (se : 'sexpr) (loc : Ploc.t) ->
                (with_constr_se se : 'with_constr)))]];
      Grammar.extension (sexpr : 'sexpr Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next
               (Grammar.r_next (Grammar.r_next Grammar.r_stop Grammar.s_self)
                  (Grammar.s_token ("DOT", "")))
               Grammar.s_self,
             "194fe98d",
             (fun (se2 : 'sexpr) _ (se1 : 'sexpr) (loc : Ploc.t) ->
                (Sacc (loc, se1, se2) : 'sexpr)))];
         None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("NL", "")),
             "194fe98d",
             (fun _ (loc : Ploc.t) -> (raise Stream.Failure : 'sexpr)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next Grammar.r_stop (Grammar.s_token ("NL", "")))
               Grammar.s_self,
             "194fe98d", (fun (s : 'sexpr) _ (loc : Ploc.t) -> (s : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_token ("ANTIQUOT_LOC", "_list")),
             "194fe98d",
             (fun (s : string) (loc : Ploc.t) ->
                (Santi (loc, "_list", s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_token ("ANTIQUOT_LOC", "list")),
             "194fe98d",
             (fun (s : string) (loc : Ploc.t) ->
                (Santi (loc, "list", s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_token ("ANTIQUOT_LOC", "_")),
             "194fe98d",
             (fun (s : string) (loc : Ploc.t) ->
                (Santi (loc, "_", s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_token ("ANTIQUOT_LOC", "")),
             "194fe98d",
             (fun (s : string) (loc : Ploc.t) ->
                (Santi (loc, "", s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("QUOT", "")),
             "194fe98d",
             (fun (s : string) (loc : Ploc.t) ->
                (let i = String.index s ':' in
                 let typ = String.sub s 0 i in
                 let txt = String.sub s (i + 1) (String.length s - i - 1) in
                 Squot (loc, typ, txt) :
                 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("SPACEDOT", "")),
             "194fe98d",
             (fun (s : string) (loc : Ploc.t) -> (Slid (loc, ".") : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("STRING", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Sstring (loc, s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("CHAR", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Schar (loc, s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("FLOAT", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Sfloat (loc, s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("INT_n", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Sint_n (loc, s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("INT_L", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Sint_L (loc, s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("INT_l", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Sint_l (loc, s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("INT", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Sint (loc, s) : 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("UIDENT", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Pcaml.vala_mapa (fun s -> Suid (loc, s))
                   (fun s -> Suidv (loc, Ploc.VaAnt s)) s :
                 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_vala [] (Grammar.s_token ("LIDENT", ""))),
             "194fe98d",
             (fun (s : string Ploc.vala) (loc : Ploc.t) ->
                (Pcaml.vala_mapa (fun s -> Slid (loc, s))
                   (fun s -> Slidv (loc, Ploc.VaAnt s)) s :
                 'sexpr)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop
               (Grammar.s_nterm
                  (pa_extend_keyword : 'pa_extend_keyword Grammar.Entry.e)),
             "194fe98d",
             (fun (a : 'pa_extend_keyword) (loc : Ploc.t) ->
                (Slid (loc, a) : 'sexpr)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next
                  (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "#(")))
                  (Grammar.s_vala []
                     (Grammar.s_list0
                        (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e)))))
               (Grammar.s_token ("", ")")),
             "194fe98d",
             (fun _ (sl : 'sexpr list Ploc.vala) _ (loc : Ploc.t) ->
                (Sarr (loc, sl) : 'sexpr)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next
                  (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "{")))
                  (Grammar.s_list0
                     (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e))))
               (Grammar.s_token ("", "}")),
             "194fe98d",
             (fun _ (sl : 'sexpr list) _ (loc : Ploc.t) ->
                (Srec (loc, sl) : 'sexpr)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next
                  (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "[")))
                  (Grammar.s_list0
                     (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e))))
               (Grammar.s_token ("", "]")),
             "194fe98d",
             (fun _ (sl : 'sexpr list) _ (loc : Ploc.t) ->
                (Slist (loc, sl) : 'sexpr)));
          Grammar.production
            (Grammar.r_next
               (Grammar.r_next
                  (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "(")))
                  (Grammar.s_list0
                     (Grammar.s_nterm (sexpr : 'sexpr Grammar.Entry.e))))
               (Grammar.s_token ("", ")")),
             "194fe98d",
             (fun _ (sl : 'sexpr list) _ (loc : Ploc.t) ->
                (Sexpr (loc, sl) : 'sexpr)))]];
      Grammar.extension
        (pa_extend_keyword : 'pa_extend_keyword Grammar.Entry.e) None
        [None, None,
         [Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "#")),
             "194fe98d",
             (fun _ (loc : Ploc.t) -> ("#" : 'pa_extend_keyword)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "/")),
             "194fe98d",
             (fun _ (loc : Ploc.t) -> ("/" : 'pa_extend_keyword)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", ":")),
             "194fe98d",
             (fun _ (loc : Ploc.t) -> (":" : 'pa_extend_keyword)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "=")),
             "194fe98d",
             (fun _ (loc : Ploc.t) -> ("=" : 'pa_extend_keyword)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", ",")),
             "194fe98d",
             (fun _ (loc : Ploc.t) -> ("," : 'pa_extend_keyword)));
          Grammar.production
            (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "_")),
             "194fe98d",
             (fun _ (loc : Ploc.t) -> ("_" : 'pa_extend_keyword)))]]])

# 3 "pa_schemer.cppo.ml"
let pa_sch s = Grammar.Entry.parse implem (Stream.of_string s)