diff options
100 files changed, 29686 insertions, 2956 deletions
diff --git a/camlp4/.vcs b/camlp4/.vcs index 6a37d4cc8..70f421104 100644 --- a/camlp4/.vcs +++ b/camlp4/.vcs @@ -1,18 +1,4 @@ --- exclude: - - !re \.cm.*$ - - Camlp4/Sig/Grammar.ml - - Camlp4/Struct/Grammar.ml - - Camlp4/Struct/Lexer.ml - - Camlp4/Sig.ml - - Camlp4/Struct.ml - - Camlp4/Syntax.ml - - Camlp4Printers.ml - - Camlp4Parsers.ml - - Camlp4Filters.ml - - .cache-status - - Camlp4.ml - - yam + - !re boot/camlp4boot\.save\..* - build/camlp4_config.ml - - !re \.tmp\.ml$ - - !re \.(run|opt)$ diff --git a/camlp4/Camlp4/Camlp4Ast.partial.ml b/camlp4/Camlp4/Camlp4Ast.partial.ml new file mode 100644 index 000000000..295d76eec --- /dev/null +++ b/camlp4/Camlp4/Camlp4Ast.partial.ml @@ -0,0 +1,341 @@ + + type meta_bool = + [ BTrue + | BFalse + | BAnt of string ]; + type meta_option 'a = + [ ONone + | OSome of 'a + | OAnt of string ]; + type ident = + [ IdAcc of Loc.t and ident and ident (* i . i *) + | IdApp of Loc.t and ident and ident (* i i *) + | IdLid of Loc.t and string (* foo *) + | IdUid of Loc.t and string (* Bar *) + | IdAnt of Loc.t and string (* $s$ *) ]; + type ctyp = + [ TyNil of Loc.t + | TyAli of Loc.t and ctyp and ctyp (* t as t *) (* list 'a as 'a *) + | TyAny of Loc.t (* _ *) + | TyApp of Loc.t and ctyp and ctyp (* t t *) (* list 'a *) + | TyArr of Loc.t and ctyp and ctyp (* t -> t *) (* int -> string *) + | TyCls of Loc.t and ident (* #i *) (* #point *) + | TyLab of Loc.t and string and ctyp (* ~s *) + | TyId of Loc.t and ident (* i *) (* Lazy.t *) + | TyMan of Loc.t and ctyp and ctyp (* t == t *) (* type t = [ A | B ] == Foo.t *) + (* type t 'a 'b 'c = t constraint t = t constraint t = t *) + | TyDcl of Loc.t and string and list ctyp and ctyp and list (ctyp * ctyp) + (* < (t)? (..)? > *) (* < move : int -> 'a .. > as 'a *) + | TyObj of Loc.t and ctyp and meta_bool + | TyOlb of Loc.t and string and ctyp (* ?s *) + | TyPol of Loc.t and ctyp and ctyp (* ! t . t *) (* ! 'a . list 'a -> 'a *) + | TyQuo of Loc.t and string (* 's *) + | TyQuP of Loc.t and string (* +'s *) + | TyQuM of Loc.t and string (* -'s *) + | TyVrn of Loc.t and string (* `s *) + | TyRec of Loc.t and ctyp (* { t } *) (* { foo : int ; bar : mutable string } *) + | TyCol of Loc.t and ctyp and ctyp (* t : t *) + | TySem of Loc.t and ctyp and ctyp (* t; t *) + | TyCom of Loc.t and ctyp and ctyp (* t, t *) + | TySum of Loc.t and ctyp (* [ t ] *) (* [ A of int and string | B ] *) + | TyOf of Loc.t and ctyp and ctyp (* t of t *) (* A of int *) + | TyAnd of Loc.t and ctyp and ctyp (* t and t *) + | TyOr of Loc.t and ctyp and ctyp (* t | t *) + | TyPrv of Loc.t and ctyp (* private t *) + | TyMut of Loc.t and ctyp (* mutable t *) + | TyTup of Loc.t and ctyp (* ( t ) *) (* (int * string) *) + | TySta of Loc.t and ctyp and ctyp (* t * t *) + | TyVrnEq of Loc.t and ctyp (* [ = t ] *) + | TyVrnSup of Loc.t and ctyp (* [ > t ] *) + | TyVrnInf of Loc.t and ctyp (* [ < t ] *) + | TyVrnInfSup of Loc.t and ctyp and ctyp (* [ < t > t ] *) + | TyAmp of Loc.t and ctyp and ctyp (* t & t *) + | TyOfAmp of Loc.t and ctyp and ctyp (* t of & t *) + | TyAnt of Loc.t and string (* $s$ *) + ] + ; + type patt = + [ PaNil of Loc.t + | PaId of Loc.t and ident (* i *) + | PaAli of Loc.t and patt and patt (* p as p *) (* (Node x y as n) *) + | PaAnt of Loc.t and string (* $s$ *) + | PaAny of Loc.t (* _ *) + | PaApp of Loc.t and patt and patt (* p p *) (* fun x y -> *) + | PaArr of Loc.t and patt (* [| p |] *) + | PaCom of Loc.t and patt and patt (* p, p *) + | PaSem of Loc.t and patt and patt (* p; p *) + | PaChr of Loc.t and string (* c *) (* 'x' *) + | PaInt of Loc.t and string + | PaInt32 of Loc.t and string + | PaInt64 of Loc.t and string + | PaNativeInt of Loc.t and string + | PaFlo of Loc.t and string + | PaLab of Loc.t and string and patt (* ~s or ~s:(p) *) + (* ?s or ?s:(p = e) or ?(p = e) *) + (* | PaOlb of Loc.t and string and meta_option(*FIXME*) (patt * meta_option(*FIXME*) expr) *) + (* ?s or ?s:(p) *) + | PaOlb of Loc.t and string and patt + (* ?s:(p = e) or ?(p = e) *) + | PaOlbi of Loc.t and string and patt and expr + | PaOrp of Loc.t and patt and patt (* p | p *) + | PaRng of Loc.t and patt and patt (* p .. p *) + | PaRec of Loc.t and patt (* { p } *) + | PaEq of Loc.t and patt and patt (* p = p *) + | PaStr of Loc.t and string (* s *) + | PaTup of Loc.t and patt (* ( p ) *) + | PaTyc of Loc.t and patt and ctyp (* (p : t) *) + | PaTyp of Loc.t and ident (* #i *) + | PaVrn of Loc.t and string (* `s *) ] + and expr = + [ ExNil of Loc.t + | ExId of Loc.t and ident (* i *) + | ExAcc of Loc.t and expr and expr (* e.e *) + | ExAnt of Loc.t and string (* $s$ *) + | ExApp of Loc.t and expr and expr (* e e *) + | ExAre of Loc.t and expr and expr (* e.(e) *) + | ExArr of Loc.t and expr (* [| e |] *) + | ExSem of Loc.t and expr and expr (* e; e *) + | ExAsf of Loc.t (* assert False *) + | ExAsr of Loc.t and expr (* assert e *) + | ExAss of Loc.t and expr and expr (* e := e *) + | ExChr of Loc.t and string (* 'c' *) + | ExCoe of Loc.t and expr and ctyp and ctyp (* (e : t) or (e : t :> t) *) + | ExFlo of Loc.t and string (* 3.14 *) + (* for s = e to/downto e do { e } *) + | ExFor of Loc.t and string and expr and expr and meta_bool and expr + | ExFun of Loc.t and match_case (* fun [ a ] *) + | ExIfe of Loc.t and expr and expr and expr (* if e then e else e *) + | ExInt of Loc.t and string (* 42 *) + | ExInt32 of Loc.t and string + | ExInt64 of Loc.t and string + | ExNativeInt of Loc.t and string + | ExLab of Loc.t and string and expr (* ~s or ~s:e *) + | ExLaz of Loc.t and expr (* lazy e *) + (* let b in e or let rec b in e *) + | ExLet of Loc.t and meta_bool and binding and expr + (* let module s = me in e *) + | ExLmd of Loc.t and string and module_expr and expr + (* match e with [ a ] *) + | ExMat of Loc.t and expr and match_case + (* new i *) + | ExNew of Loc.t and ident + (* object ((p))? (cst)? end *) + | ExObj of Loc.t and patt and class_str_item + (* ?s or ?s:e *) + | ExOlb of Loc.t and string and expr + (* {< b >} *) + | ExOvr of Loc.t and binding + (* { b } or { (e) with b } *) + | ExRec of Loc.t and binding and expr + (* do { e } *) + | ExSeq of Loc.t and expr + (* e#s *) + | ExSnd of Loc.t and expr and string + (* e.[e] *) + | ExSte of Loc.t and expr and expr + (* s *) (* "foo" *) + | ExStr of Loc.t and string + (* try e with [ a ] *) + | ExTry of Loc.t and expr and match_case + (* (e) *) + | ExTup of Loc.t and expr + (* e, e *) + | ExCom of Loc.t and expr and expr + (* (e : t) *) + | ExTyc of Loc.t and expr and ctyp + (* `s *) + | ExVrn of Loc.t and string + (* while e do { e } *) + | ExWhi of Loc.t and expr and expr ] + and module_type = + (* i *) (* A.B.C *) + [ MtId of Loc.t and ident + (* functor (s : mt) -> mt *) + | MtFun of Loc.t and string and module_type and module_type + (* 's *) + | MtQuo of Loc.t and string + (* sig (sg)? end *) + | MtSig of Loc.t and sig_item + (* mt with wc *) + | MtWit of Loc.t and module_type and with_constr + | MtAnt of Loc.t and string (* $s$ *) ] + and sig_item = + [ SgNil of Loc.t + (* class cict *) + | SgCls of Loc.t and class_type + (* class type cict *) + | SgClt of Loc.t and class_type + (* sg ; sg *) + | SgSem of Loc.t and sig_item and sig_item + (* # s or # s e *) + | SgDir of Loc.t and string and expr + (* exception t *) + | SgExc of Loc.t and ctyp + (* |+ external s : t = s ... s +| + | SgExt of Loc.t and string and ctyp and list string *) + (* external s : t = s *) + | SgExt of Loc.t and string and ctyp and string + (* include mt *) + | SgInc of Loc.t and module_type + (* module s : mt *) + | SgMod of Loc.t and string and module_type + (* module rec mb *) + | SgRecMod of Loc.t and module_binding + (* module type s = mt *) + | SgMty of Loc.t and string and module_type + (* open i *) + | SgOpn of Loc.t and ident + (* type t *) + | SgTyp of Loc.t and ctyp + (* value s : t *) + | SgVal of Loc.t and string and ctyp + | SgAnt of Loc.t and string (* $s$ *) ] + and with_constr = + [ WcNil of Loc.t + (* type t = t *) + | WcTyp of Loc.t and ctyp and ctyp + (* module i = i *) + | WcMod of Loc.t and ident and ident + (* wc and wc *) + | WcAnd of Loc.t and with_constr and with_constr + | WcAnt of Loc.t and string (* $s$ *) ] + and binding = + [ BiNil of Loc.t + (* b and b *) (* let a = 42 and c = 43 *) + | BiAnd of Loc.t and binding and binding + (* b ; b *) + | BiSem of Loc.t and binding and binding + (* p = e *) (* let patt = expr *) + | BiEq of Loc.t and patt and expr + | BiAnt of Loc.t and string (* $s$ *) ] + and module_binding = + [ MbNil of Loc.t + (* mb and mb *) (* module rec (s : mt) = me and (s : mt) = me *) + | MbAnd of Loc.t and module_binding and module_binding + (* s : mt = me *) + | MbColEq of Loc.t and string and module_type and module_expr + (* s : mt *) + | MbCol of Loc.t and string and module_type + | MbAnt of Loc.t and string (* $s$ *) ] + and match_case = + [ McNil of Loc.t + (* a | a *) + | McOr of Loc.t and match_case and match_case + (* p (when e)? -> e *) + | McArr of Loc.t and patt and expr and expr + | McAnt of Loc.t and string (* $s$ *) ] + and module_expr = + (* i *) + [ MeId of Loc.t and ident + (* me me *) + | MeApp of Loc.t and module_expr and module_expr + (* functor (s : mt) -> me *) + | MeFun of Loc.t and string and module_type and module_expr + (* struct (st)? end *) + | MeStr of Loc.t and str_item + (* (me : mt) *) + | MeTyc of Loc.t and module_expr and module_type + | MeAnt of Loc.t and string (* $s$ *) ] + and str_item = + [ StNil of Loc.t + (* class cice *) + | StCls of Loc.t and class_expr + (* class type cict *) + | StClt of Loc.t and class_type + (* st ; st *) + | StSem of Loc.t and str_item and str_item + (* # s or # s e *) + | StDir of Loc.t and string and expr + (* exception t or exception t = i *) + | StExc of Loc.t and ctyp and meta_option(*FIXME*) ident + (* e *) + | StExp of Loc.t and expr + (* |+ external s : t = s ... s +| + | StExt of Loc.t and string and ctyp and list string *) + (* external s : t = s *) + | StExt of Loc.t and string and ctyp and string + (* include me *) + | StInc of Loc.t and module_expr + (* module s = me *) + | StMod of Loc.t and string and module_expr + (* module rec mb *) + | StRecMod of Loc.t and module_binding + (* module type s = mt *) + | StMty of Loc.t and string and module_type + (* open i *) + | StOpn of Loc.t and ident + (* type t *) + | StTyp of Loc.t and ctyp + (* value b or value rec b *) + | StVal of Loc.t and meta_bool and binding + | StAnt of Loc.t and string (* $s$ *) ] + and class_type = + [ CtNil of Loc.t + (* (virtual)? i ([ t ])? *) + | CtCon of Loc.t and meta_bool and ident and ctyp + (* [t] -> ct *) + | CtFun of Loc.t and ctyp and class_type + (* object ((t))? (csg)? end *) + | CtSig of Loc.t and ctyp and class_sig_item + (* ct and ct *) + | CtAnd of Loc.t and class_type and class_type + (* ct : ct *) + | CtCol of Loc.t and class_type and class_type + (* ct = ct *) + | CtEq of Loc.t and class_type and class_type + (* $s$ *) + | CtAnt of Loc.t and string ] + and class_sig_item = + [ CgNil of Loc.t + (* type t = t *) + | CgCtr of Loc.t and ctyp and ctyp + (* csg ; csg *) + | CgSem of Loc.t and class_sig_item and class_sig_item + (* inherit ct *) + | CgInh of Loc.t and class_type + (* method s : t or method private s : t *) + | CgMth of Loc.t and string and meta_bool and ctyp + (* value (virtual)? (mutable)? s : t *) + | CgVal of Loc.t and string and meta_bool and meta_bool and ctyp + (* method virtual (mutable)? s : t *) + | CgVir of Loc.t and string and meta_bool and ctyp + | CgAnt of Loc.t and string (* $s$ *) ] + and class_expr = + [ CeNil of Loc.t + (* ce e *) + | CeApp of Loc.t and class_expr and expr + (* (virtual)? i ([ t ])? *) + | CeCon of Loc.t and meta_bool and ident and ctyp + (* fun p -> ce *) + | CeFun of Loc.t and patt and class_expr + (* let (rec)? b in ce *) + | CeLet of Loc.t and meta_bool and binding and class_expr + (* object ((p))? (cst)? end *) + | CeStr of Loc.t and patt and class_str_item + (* ce : ct *) + | CeTyc of Loc.t and class_expr and class_type + (* ce and ce *) + | CeAnd of Loc.t and class_expr and class_expr + (* ce = ce *) + | CeEq of Loc.t and class_expr and class_expr + (* $s$ *) + | CeAnt of Loc.t and string ] + and class_str_item = + [ CrNil of Loc.t + (* cst ; cst *) + | CrSem of Loc.t and class_str_item and class_str_item + (* type t = t *) + | CrCtr of Loc.t and ctyp and ctyp + (* inherit ce or inherit ce as s *) + | CrInh of Loc.t and class_expr and string + (* initializer e *) + | CrIni of Loc.t and expr + (* method (private)? s : t = e or method (private)? s = e *) + | CrMth of Loc.t and string and meta_bool and expr and ctyp + (* value (mutable)? s = e *) + | CrVal of Loc.t and string and meta_bool and expr + (* method virtual (private)? s : t *) + | CrVir of Loc.t and string and meta_bool and ctyp + (* value virtual (private)? s : t *) + | CrVvr of Loc.t and string and meta_bool and ctyp + | CrAnt of Loc.t and string (* $s$ *) ]; diff --git a/camlp4/Camlp4/Config.ml b/camlp4/Camlp4/Config.ml deleted file mode 100644 index 77e71d084..000000000 --- a/camlp4/Camlp4/Config.ml +++ /dev/null @@ -1,51 +0,0 @@ -(* camlp4r *) -(****************************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* INRIA Rocquencourt *) -(* *) -(* Copyright 2006 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed under *) -(* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the Objective *) -(* Caml source tree. *) -(* *) -(****************************************************************************) - -(* Authors: - * - Daniel de Rauglaudre: initial version - * - Nicolas Pouillard: refactoring - *) - -value standard_library_default = Camlp4_config.libdir; - -value ocaml_standard_library = - try Sys.getenv "OCAMLLIB" - with [ Not_found -> - try Sys.getenv "CAMLLIB" - with [ Not_found -> - standard_library_default ] ]; - -value camlp4_standard_library = - try Sys.getenv "CAMLP4LIB" - with [ Not_found -> - Filename.concat (try Sys.getenv "OCAMLLIB" - with [ Not_found -> - try Sys.getenv "CAMLLIB" - with [ Not_found -> - standard_library_default]]) - "camlp4"]; - -value version = Sys.ocaml_version; -value program_name = ref "camlp4"; -value constructors_arity = ref True; -value unsafe = ref False; -value verbose = ref False; -value quotations = ref True; -value inter_phrases = ref None; -value camlp4_ast_impl_magic_number = "Camlp42006M001"; -value camlp4_ast_intf_magic_number = "Camlp42006N001"; -value ocaml_ast_intf_magic_number = Camlp4_config.ast_intf_magic_number; -value ocaml_ast_impl_magic_number = Camlp4_config.ast_impl_magic_number; -value current_input_file = ref ""; diff --git a/camlp4/Camlp4/Debug.ml b/camlp4/Camlp4/Debug.ml index 064f9ee18..e99ec9e19 100644 --- a/camlp4/Camlp4/Debug.ml +++ b/camlp4/Camlp4/Debug.ml @@ -19,6 +19,8 @@ (* camlp4r *) open Format; +module Debug = struct value mode _ = False; end; + type section = string; value out_channel = diff --git a/camlp4/Camlp4/ErrorHandler.ml b/camlp4/Camlp4/ErrorHandler.ml index 12eec1127..7c68bd4fc 100644 --- a/camlp4/Camlp4/ErrorHandler.ml +++ b/camlp4/Camlp4/ErrorHandler.ml @@ -131,7 +131,7 @@ value register f = fun ppf default_handler exn -> try f ppf exn with exn -> current_handler ppf default_handler exn; -module Register (Error : Sig.Error.S) = struct +module Register (Error : Sig.Error) = struct let current_handler = handler.val in handler.val := fun ppf default_handler -> diff --git a/camlp4/Camlp4/ErrorHandler.mli b/camlp4/Camlp4/ErrorHandler.mli index 7c3463be9..674811459 100644 --- a/camlp4/Camlp4/ErrorHandler.mli +++ b/camlp4/Camlp4/ErrorHandler.mli @@ -25,7 +25,7 @@ value try_to_string : exn -> string; value register : (Format.formatter -> exn -> unit) -> unit; -module Register (Error : Sig.Error.S) : sig end; +module Register (Error : Sig.Error) : sig end; module ObjTools : sig value print : Format.formatter -> Obj.t -> unit; diff --git a/camlp4/Camlp4/OCamlInitSyntax.ml b/camlp4/Camlp4/OCamlInitSyntax.ml index babc4a73b..b28c40e05 100644 --- a/camlp4/Camlp4/OCamlInitSyntax.ml +++ b/camlp4/Camlp4/OCamlInitSyntax.ml @@ -16,16 +16,16 @@ * - Nicolas Pouillard: initial version *) -module Make (Warning : Sig.Warning.S) - (Ast : Sig.Camlp4Ast.S with module Loc = Warning.Loc) - (Gram : Sig.Grammar.Static.S with module Loc = Warning.Loc - with type Token.t = Sig.Camlp4Token.t) - (Quotation : Sig.Quotation.S with module Ast = Sig.Camlp4Ast.ToAst Ast) -: Sig.Camlp4Syntax.S with module Loc = Ast.Loc +module Make (Warning : Sig.Warning) + (Ast : Sig.Camlp4Ast with module Loc = Warning.Loc) + (Gram : Sig.Grammar.Static with module Loc = Warning.Loc + with type Token.t = Sig.camlp4_token) + (Quotation : Sig.Quotation with module Ast = Sig.Camlp4AstToAst Ast) +: Sig.Camlp4Syntax with module Loc = Ast.Loc and module Ast = Ast and module Token = Gram.Token and module Gram = Gram - and module AntiquotSyntax.Ast = Sig.Camlp4Ast.ToAst Ast + and module AntiquotSyntax.Ast = Sig.Camlp4AstToAst Ast and module Quotation = Quotation = struct @@ -34,7 +34,7 @@ module Make (Warning : Sig.Warning.S) module Ast = Ast; module Gram = Gram; module Token = Gram.Token; - open Sig.Camlp4Token; + open Sig; value a_CHAR = Gram.Entry.mk "a_CHAR"; value a_FLOAT = Gram.Entry.mk "a_FLOAT"; @@ -197,7 +197,7 @@ module Make (Warning : Sig.Warning.S) module AntiquotSyntax = struct module Loc = Ast.Loc; - module Ast = Sig.Camlp4Ast.ToAst Ast; + module Ast = Sig.Camlp4AstToAst Ast; module Gram = Gram; value antiquot_expr = Gram.Entry.mk "antiquot_expr"; value antiquot_patt = Gram.Entry.mk "antiquot_patt"; diff --git a/camlp4/Camlp4/PreCast.ml b/camlp4/Camlp4/PreCast.ml index 5e2af1a57..8c29bb1de 100644 --- a/camlp4/Camlp4/PreCast.ml +++ b/camlp4/Camlp4/PreCast.ml @@ -22,7 +22,7 @@ module Id = struct value version = "$Id$"; end; -type camlp4_token = Sig.Camlp4Token.t == +type camlp4_token = Sig.camlp4_token == [ KEYWORD of string | SYMBOL of string | LIDENT of string @@ -37,7 +37,7 @@ type camlp4_token = Sig.Camlp4Token.t == | STRING of string and string | LABEL of string | OPTLABEL of string - | QUOTATION of Sig.Quotation.t + | QUOTATION of Sig.quotation | ANTIQUOT of string and string | COMMENT of string | BLANKS of string @@ -53,7 +53,8 @@ module Lexer = Struct.Lexer.Make Token; module Gram = Struct.Grammar.Static.Make Lexer; module DynLoader = Struct.DynLoader; module Quotation = Struct.Quotation.Make Ast; -module Syntax = OCamlInitSyntax.Make Warning Ast Gram Quotation; +module MakeSyntax (U : sig end) = OCamlInitSyntax.Make Warning Ast Gram Quotation; +module Syntax = MakeSyntax (struct end); module AstFilters = Struct.AstFilters.Make Ast; module MakeGram = Struct.Grammar.Static.Make; diff --git a/camlp4/Camlp4/PreCast.mli b/camlp4/Camlp4/PreCast.mli index 6da6f72e7..fd64e6d19 100644 --- a/camlp4/Camlp4/PreCast.mli +++ b/camlp4/Camlp4/PreCast.mli @@ -17,7 +17,7 @@ * - Nicolas Pouillard: refactoring *) -type camlp4_token = Sig.Camlp4Token.t == +type camlp4_token = Sig.camlp4_token == [ KEYWORD of string | SYMBOL of string | LIDENT of string @@ -32,7 +32,7 @@ type camlp4_token = Sig.Camlp4Token.t == | STRING of string and string | LABEL of string | OPTLABEL of string - | QUOTATION of Sig.Quotation.t + | QUOTATION of Sig.quotation | ANTIQUOT of string and string | COMMENT of string | BLANKS of string @@ -40,23 +40,23 @@ type camlp4_token = Sig.Camlp4Token.t == | LINE_DIRECTIVE of int and option string | EOI ]; -module Id : Sig.Id.S; -module Loc : Sig.Loc.S; -module Warning : Sig.Warning.S with module Loc = Loc; -module Ast : Sig.Camlp4Ast.S with module Loc = Loc; -module Token : Sig.Token.S +module Id : Sig.Id; +module Loc : Sig.Loc; +module Warning : Sig.Warning with module Loc = Loc; +module Ast : Sig.Camlp4Ast with module Loc = Loc; +module Token : Sig.Token with module Loc = Loc and type t = camlp4_token; -module Lexer : Sig.Lexer.S +module Lexer : Sig.Lexer with module Loc = Loc and module Token = Token; -module Gram : Sig.Grammar.Static.S +module Gram : Sig.Grammar.Static with module Loc = Loc and module Token = Token; -module Quotation : Sig.Quotation.S with module Ast = Sig.Camlp4Ast.ToAst Ast; -module DynLoader : Sig.DynLoader.S; -module AstFilters : Sig.AstFilters.S with module Ast = Ast; -module Syntax : Sig.Camlp4Syntax.S +module Quotation : Sig.Quotation with module Ast = Sig.Camlp4AstToAst Ast; +module DynLoader : Sig.DynLoader; +module AstFilters : Sig.AstFilters with module Ast = Ast; +module Syntax : Sig.Camlp4Syntax with module Loc = Loc and module Warning = Warning and module Token = Token @@ -65,13 +65,15 @@ module Syntax : Sig.Camlp4Syntax.S and module Quotation = Quotation; module Printers : sig - module OCaml : Sig.Printer.S with module Ast = Sig.Camlp4Ast.ToAst Ast; - module OCamlr : Sig.Printer.S with module Ast = Sig.Camlp4Ast.ToAst Ast; - (* module OCamlrr : Sig.Printer.S with module Ast = Sig.Camlp4Ast.ToAst Ast; *) - module DumpOCamlAst : Sig.Printer.S with module Ast = Sig.Camlp4Ast.ToAst Ast; - module DumpCamlp4Ast : Sig.Printer.S with module Ast = Sig.Camlp4Ast.ToAst Ast; - module Null : Sig.Printer.S with module Ast = Sig.Camlp4Ast.ToAst Ast; + module OCaml : Sig.Printer with module Ast = Sig.Camlp4AstToAst Ast; + module OCamlr : Sig.Printer with module Ast = Sig.Camlp4AstToAst Ast; + (* module OCamlrr : Sig.Printer with module Ast = Sig.Camlp4AstToAst Ast; *) + module DumpOCamlAst : Sig.Printer with module Ast = Sig.Camlp4AstToAst Ast; + module DumpCamlp4Ast : Sig.Printer with module Ast = Sig.Camlp4AstToAst Ast; + module Null : Sig.Printer with module Ast = Sig.Camlp4AstToAst Ast; end; -module MakeGram (Lexer : Sig.Lexer.S with module Loc = Loc) - : Sig.Grammar.Static.S with module Loc = Loc and module Token = Lexer.Token; +module MakeGram (Lexer : Sig.Lexer with module Loc = Loc) + : Sig.Grammar.Static with module Loc = Loc and module Token = Lexer.Token; + +module MakeSyntax (U : sig end) : Sig.Syntax; diff --git a/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml b/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml index 7ed144f0e..40b597921 100644 --- a/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml +++ b/camlp4/Camlp4/Printers/DumpCamlp4Ast.ml @@ -22,8 +22,8 @@ module Id = struct value version = "$Id$"; end; -module Make (Syntax : Sig.Syntax.S) -: Sig.Printer.S with module Ast = Syntax.Ast +module Make (Syntax : Sig.Syntax) +: Sig.Printer with module Ast = Syntax.Ast = struct include Syntax; @@ -41,10 +41,10 @@ module Make (Syntax : Sig.Syntax.S) value print_interf ?input_file:(_) ?output_file ast = with_open_out_file output_file - (dump_ast Config.camlp4_ast_intf_magic_number ast); + (dump_ast Camlp4_config.camlp4_ast_intf_magic_number ast); value print_implem ?input_file:(_) ?output_file ast = with_open_out_file output_file - (dump_ast Config.camlp4_ast_impl_magic_number ast); + (dump_ast Camlp4_config.camlp4_ast_impl_magic_number ast); end; diff --git a/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli b/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli index 66dd5b3f7..0af1fa1a7 100644 --- a/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli +++ b/camlp4/Camlp4/Printers/DumpCamlp4Ast.mli @@ -16,7 +16,7 @@ * - Nicolas Pouillard: initial version *) -module Id : Sig.Id.S; +module Id : Sig.Id; -module Make (Syntax : Sig.Syntax.S) : Sig.Printer.S +module Make (Syntax : Sig.Syntax) : Sig.Printer with module Ast = Syntax.Ast; diff --git a/camlp4/Camlp4/Printers/DumpOCamlAst.ml b/camlp4/Camlp4/Printers/DumpOCamlAst.ml index bd808f330..ee35d5142 100644 --- a/camlp4/Camlp4/Printers/DumpOCamlAst.ml +++ b/camlp4/Camlp4/Printers/DumpOCamlAst.ml @@ -17,13 +17,13 @@ * - Nicolas Pouillard: refactoring *) -module Id : Sig.Id.S = struct +module Id : Sig.Id = struct value name = "Camlp4Printers.DumpOCamlAst"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) -: Sig.Printer.S with module Ast = Syntax.Ast +module Make (Syntax : Sig.Camlp4Syntax) +: Sig.Printer with module Ast = Syntax.Ast = struct include Syntax; module Ast2pt = Struct.Camlp4Ast2OCamlAst.Make Ast; @@ -43,10 +43,10 @@ module Make (Syntax : Sig.Camlp4Syntax.S) value print_interf ?(input_file = "-") ?output_file ast = let pt = Ast2pt.sig_item ast in - with_open_out_file output_file (dump_pt Config.ocaml_ast_intf_magic_number input_file pt); + with_open_out_file output_file (dump_pt Camlp4_config.ocaml_ast_intf_magic_number input_file pt); value print_implem ?(input_file = "-") ?output_file ast = let pt = Ast2pt.str_item ast in - with_open_out_file output_file (dump_pt Config.ocaml_ast_impl_magic_number input_file pt); + with_open_out_file output_file (dump_pt Camlp4_config.ocaml_ast_impl_magic_number input_file pt); end; diff --git a/camlp4/Camlp4/Printers/DumpOCamlAst.mli b/camlp4/Camlp4/Printers/DumpOCamlAst.mli index e4eecbbe8..b97898b19 100644 --- a/camlp4/Camlp4/Printers/DumpOCamlAst.mli +++ b/camlp4/Camlp4/Printers/DumpOCamlAst.mli @@ -16,7 +16,7 @@ * - Nicolas Pouillard: initial version *) -module Id : Sig.Id.S; +module Id : Sig.Id; -module Make (Syntax : Sig.Camlp4Syntax.S) : Sig.Printer.S +module Make (Syntax : Sig.Camlp4Syntax) : Sig.Printer with module Ast = Syntax.Ast; diff --git a/camlp4/Camlp4/Printers/Null.ml b/camlp4/Camlp4/Printers/Null.ml index 7852b6ffc..ba66558e6 100644 --- a/camlp4/Camlp4/Printers/Null.ml +++ b/camlp4/Camlp4/Printers/Null.ml @@ -22,7 +22,7 @@ module Id = struct value version = "$Id$"; end; -module Make (Syntax : Sig.Syntax.S) = struct +module Make (Syntax : Sig.Syntax) = struct include Syntax; value print_interf ?input_file:(_) ?output_file:(_) _ = (); diff --git a/camlp4/Camlp4/Printers/Null.mli b/camlp4/Camlp4/Printers/Null.mli index a3fcbac74..562c2c02f 100644 --- a/camlp4/Camlp4/Printers/Null.mli +++ b/camlp4/Camlp4/Printers/Null.mli @@ -17,6 +17,6 @@ * - Nicolas Pouillard: refactoring *) -module Id : Sig.Id.S; +module Id : Sig.Id; -module Make (Syntax : Sig.Syntax.S) : Sig.Printer.S with module Ast = Syntax.Ast; +module Make (Syntax : Sig.Syntax) : Sig.Printer with module Ast = Syntax.Ast; diff --git a/camlp4/Camlp4/Printers/OCaml.ml b/camlp4/Camlp4/Printers/OCaml.ml index 81b92324d..b31c3d010 100644 --- a/camlp4/Camlp4/Printers/OCaml.ml +++ b/camlp4/Camlp4/Printers/OCaml.ml @@ -23,7 +23,7 @@ module Id = struct value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct +module Make (Syntax : Sig.Camlp4Syntax) = struct include Syntax; value pp = fprintf; @@ -79,9 +79,9 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct module Lexer = Struct.Lexer.Make Token; let module M = ErrorHandler.Register Lexer.Error in (); - open Sig.Camlp4Token; + open Sig; value lexer s = - Lexer.from_string ~quotations:Config.quotations.val Loc.ghost s; + Lexer.from_string ~quotations:Camlp4_config.quotations.val Loc.ghost s; value lex_string str = try match lexer str with parser [: `(tok, _); `(EOI, _) :] -> tok @@ -141,7 +141,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct do_print_comments_before loc f s | [: :] -> () ]; - class printer ?(curry_constr = False) ?(comments = True) () = + class printer ?curry_constr:(init_curry_constr = False) ?(comments = True) () = object (o) (** pipe means we are under a match case (try, function) *) @@ -158,7 +158,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct value value_val = "val"; value value_let = "let"; value mode = if comments then `comments else `no_comments; - value curry_constr = curry_constr; + value curry_constr = init_curry_constr; value var_conversion = False; method semisep = semisep; @@ -436,7 +436,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct | <:expr< if $e1$ then $e2$ else $e3$ >> -> pp f "@[<hv0>@[<2>if@ %a@]@ @[<2>then@ %a@]@ @[<2>else@ %a@]@]" o#expr e1 o#under_semi#expr e2 o#under_semi#expr e3 - | <:expr< lazy $e$ >> -> pp f "@[<2>lazy@ %a@]" o#expr e + | <:expr< lazy $e$ >> -> pp f "@[<2>lazy@ %a@]" o#simple_expr e | <:expr< let $rec:r$ $bi$ in $e$ >> -> match e with [ <:expr< let $rec:_$ $_$ in $_$ >> -> @@ -1006,8 +1006,8 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct end; -module MakeMore (Syntax : Sig.Camlp4Syntax.S) -: Sig.Printer.S with module Ast = Syntax.Ast +module MakeMore (Syntax : Sig.Camlp4Syntax) +: Sig.Printer with module Ast = Syntax.Ast = struct include Make Syntax; diff --git a/camlp4/Camlp4/Printers/OCaml.mli b/camlp4/Camlp4/Printers/OCaml.mli index 9060e54dc..ba930cf9a 100644 --- a/camlp4/Camlp4/Printers/OCaml.mli +++ b/camlp4/Camlp4/Printers/OCaml.mli @@ -16,11 +16,11 @@ * - Nicolas Pouillard: initial version *) -module Id : Sig.Id.S; +module Id : Sig.Id; -module Make (Syntax : Sig.Camlp4Syntax.S) : sig +module Make (Syntax : Sig.Camlp4Syntax) : sig open Format; - include Sig.Camlp4Syntax.S + include Sig.Camlp4Syntax with module Loc = Syntax.Loc and module Warning = Syntax.Warning and module Token = Syntax.Token @@ -164,5 +164,5 @@ module Make (Syntax : Sig.Camlp4Syntax.S) : sig ?input_file: string -> ?output_file: string -> Ast.str_item -> unit; end; -module MakeMore (Syntax : Sig.Camlp4Syntax.S) -: Sig.Printer.S with module Ast = Syntax.Ast; +module MakeMore (Syntax : Sig.Camlp4Syntax) +: Sig.Printer with module Ast = Syntax.Ast; diff --git a/camlp4/Camlp4/Printers/OCamlr.ml b/camlp4/Camlp4/Printers/OCamlr.ml index eaaa96c02..66a089c17 100644 --- a/camlp4/Camlp4/Printers/OCamlr.ml +++ b/camlp4/Camlp4/Printers/OCamlr.ml @@ -23,9 +23,9 @@ module Id = struct value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct +module Make (Syntax : Sig.Camlp4Syntax) = struct include Syntax; - open Sig.Camlp4Token; + open Sig; module PP_o = OCaml.Make Syntax; @@ -33,16 +33,16 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct value pp = fprintf; - class printer ?(curry_constr = True) ?(comments = True) () = + class printer ?curry_constr:(init_curry_constr = True) ?(comments = True) () = object (o) - inherit PP_o.printer ~curry_constr ~comments () as super; + inherit PP_o.printer ~curry_constr:init_curry_constr ~comments () as super; value semisep = ";"; value andsep : format unit formatter unit = "@]@ @[<2>and@ "; value value_val = "value"; value value_let = "value"; value mode = if comments then `comments else `no_comments; - value curry_constr = curry_constr; + value curry_constr = init_curry_constr; value first_match_case = True; method under_pipe = o; @@ -122,8 +122,16 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct method ident f i = let () = o#node f i Ast.loc_of_ident in match i with - [ <:ident< $i1$ $i2$ >> -> pp f "%a@ %a" o#ident i1 o#ident i2 - | i -> super#ident f i ]; + [ <:ident< $i1$ $i2$ >> -> pp f "%a@ %a" o#dot_ident i1 o#dot_ident i2 + | i -> o#dot_ident f i ]; + + method private dot_ident f i = + let () = o#node f i Ast.loc_of_ident in + match i with + [ <:ident< $i1$.$i2$ >> -> pp f "%a.@,%a" o#dot_ident i1 o#dot_ident i2 + | <:ident< $anti:s$ >> -> o#anti f s + | <:ident< $lid:s$ >> | <:ident< $uid:s$ >> -> o#var f s + | i -> pp f "(%a)" o#ident i ]; method patt4 f = fun [ <:patt< [$_$ :: $_$] >> as p -> @@ -184,6 +192,8 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct | _ -> pp f " =@ %a" o#ctyp te ]; if cl <> [] then pp f "@ %a" (list o#constrain "@ ") cl else (); } + | <:ctyp< $t1$ : mutable $t2$ >> -> + pp f "@[%a :@ mutable %a@]" o#ctyp t1 o#ctyp t2 | t -> super#ctyp f t ]; method simple_ctyp f t = @@ -235,6 +245,16 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct match ct with [ <:class_type< [ $t$ ] -> $ct$ >> -> pp f "@[<2>[ %a ] ->@ %a@]" o#simple_ctyp t o#class_type ct + | <:class_type< $id:i$ >> -> + pp f "@[<2>%a@]" o#ident i + | <:class_type< $id:i$ [ $t$ ] >> -> + pp f "@[<2>%a [@,%a@]@,]" o#ident i o#class_params t + (* | <:class_type< virtual $id:i$ >> -> *) + | Ast.CtCon _ Ast.BTrue i <:ctyp<>> -> + pp f "@[<2>virtual@ %a@]" o#ident i + (* | <:class_type< virtual $id:i$ [ $t$ ] >> -> *) + | Ast.CtCon _ Ast.BTrue i t -> + pp f "@[<2>virtual@ %a@ [@,%a@]@,]" o#ident i o#class_params t | ct -> super#class_type f ct ]; method class_expr f ce = @@ -260,8 +280,8 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct end; -module MakeMore (Syntax : Sig.Camlp4Syntax.S) -: Sig.Printer.S with module Ast = Syntax.Ast +module MakeMore (Syntax : Sig.Camlp4Syntax) +: Sig.Printer with module Ast = Syntax.Ast = struct include Make Syntax; diff --git a/camlp4/Camlp4/Printers/OCamlr.mli b/camlp4/Camlp4/Printers/OCamlr.mli index 5562d06be..c09bf6eb5 100644 --- a/camlp4/Camlp4/Printers/OCamlr.mli +++ b/camlp4/Camlp4/Printers/OCamlr.mli @@ -16,11 +16,11 @@ * - Nicolas Pouillard: initial version *) -module Id : Sig.Id.S; +module Id : Sig.Id; -module Make (Syntax : Sig.Camlp4Syntax.S) : sig +module Make (Syntax : Sig.Camlp4Syntax) : sig open Format; - include Sig.Camlp4Syntax.S + include Sig.Camlp4Syntax with module Loc = Syntax.Loc and module Warning = Syntax.Warning and module Token = Syntax.Token @@ -51,5 +51,5 @@ module Make (Syntax : Sig.Camlp4Syntax.S) : sig ?input_file: string -> ?output_file: string -> Ast.str_item -> unit; end; -module MakeMore (Syntax : Sig.Camlp4Syntax.S) -: Sig.Printer.S with module Ast = Syntax.Ast; +module MakeMore (Syntax : Sig.Camlp4Syntax) +: Sig.Printer with module Ast = Syntax.Ast; diff --git a/camlp4/Camlp4/Register.ml b/camlp4/Camlp4/Register.ml index feff6880a..e491f4c17 100644 --- a/camlp4/Camlp4/Register.ml +++ b/camlp4/Camlp4/Register.ml @@ -52,27 +52,27 @@ value register_sig_item_printer f = sig_item_printer.val := f; value register_printer f g = do { str_item_printer.val := f; sig_item_printer.val := g }; -module Plugin (Id : Sig.Id.S) (Maker : functor (Unit : sig end) -> sig end) = struct +module Plugin (Id : Sig.Id) (Maker : functor (Unit : sig end) -> sig end) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker (struct end) in ()); end; -module SyntaxExtension (Id : Sig.Id.S) (Maker : Sig.SyntaxExtension.S) = struct +module SyntaxExtension (Id : Sig.Id) (Maker : Sig.SyntaxExtension) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in ()); end; module OCamlSyntaxExtension - (Id : Sig.Id.S) (Maker : functor (Syn : Sig.Camlp4Syntax.S) -> Sig.Camlp4Syntax.S) = + (Id : Sig.Id) (Maker : functor (Syn : Sig.Camlp4Syntax) -> Sig.Camlp4Syntax) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in ()); end; -module SyntaxPlugin (Id : Sig.Id.S) (Maker : functor (Syn : Sig.Syntax.S) -> sig end) = struct +module SyntaxPlugin (Id : Sig.Id) (Maker : functor (Syn : Sig.Syntax) -> sig end) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in ()); end; module Printer - (Id : Sig.Id.S) (Maker : functor (Syn : Sig.Syntax.S) - -> Sig.Printer.S with module Ast = Syn.Ast) = + (Id : Sig.Id) (Maker : functor (Syn : Sig.Syntax) + -> Sig.Printer with module Ast = Syn.Ast) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in @@ -80,8 +80,8 @@ struct end; module OCamlPrinter - (Id : Sig.Id.S) (Maker : functor (Syn : Sig.Camlp4Syntax.S) - -> Sig.Printer.S with module Ast = Syn.Ast) = + (Id : Sig.Id) (Maker : functor (Syn : Sig.Camlp4Syntax) + -> Sig.Printer with module Ast = Syn.Ast) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker Syntax in @@ -89,15 +89,15 @@ struct end; module OCamlPreCastPrinter - (Id : Sig.Id.S) (P : Sig.Printer.S with module Ast = PreCast.Ast) = + (Id : Sig.Id) (P : Sig.Printer with module Ast = PreCast.Ast) = struct declare_dyn_module Id.name (fun _ -> register_printer P.print_implem P.print_interf); end; module Parser - (Id : Sig.Id.S) (Maker : functor (Ast : Sig.Ast.S) - -> Sig.Parser.S with module Ast = Ast) = + (Id : Sig.Id) (Maker : functor (Ast : Sig.Ast) + -> Sig.Parser with module Ast = Ast) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker PreCast.Ast in @@ -105,8 +105,8 @@ struct end; module OCamlParser - (Id : Sig.Id.S) (Maker : functor (Ast : Sig.Camlp4Ast.S) - -> Sig.Parser.S with module Ast = Ast) = + (Id : Sig.Id) (Maker : functor (Ast : Sig.Camlp4Ast) + -> Sig.Parser with module Ast = Ast) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker PreCast.Ast in @@ -114,14 +114,14 @@ struct end; module OCamlPreCastParser - (Id : Sig.Id.S) (P : Sig.Parser.S with module Ast = PreCast.Ast) = + (Id : Sig.Id) (P : Sig.Parser with module Ast = PreCast.Ast) = struct declare_dyn_module Id.name (fun _ -> register_parser P.parse_implem P.parse_interf); end; module AstFilter - (Id : Sig.Id.S) (Maker : functor (F : Sig.AstFilters.S) -> sig end) = + (Id : Sig.Id) (Maker : functor (F : Sig.AstFilters) -> sig end) = struct declare_dyn_module Id.name (fun _ -> let module M = Maker AstFilters in ()); end; diff --git a/camlp4/Camlp4/Register.mli b/camlp4/Camlp4/Register.mli index edba1fa72..337ca55d2 100644 --- a/camlp4/Camlp4/Register.mli +++ b/camlp4/Camlp4/Register.mli @@ -18,18 +18,18 @@ *) module Plugin - (Id : Sig.Id.S) (Plugin : functor (Unit : sig end) -> sig end) : sig end; + (Id : Sig.Id) (Plugin : functor (Unit : sig end) -> sig end) : sig end; module SyntaxPlugin - (Id : Sig.Id.S) (SyntaxPlugin : functor (Syn : Sig.Syntax.S) -> sig end) : + (Id : Sig.Id) (SyntaxPlugin : functor (Syn : Sig.Syntax) -> sig end) : sig end; module SyntaxExtension - (Id : Sig.Id.S) (SyntaxExtension : Sig.SyntaxExtension.S) : sig end; + (Id : Sig.Id) (SyntaxExtension : Sig.SyntaxExtension) : sig end; module OCamlSyntaxExtension - (Id : Sig.Id.S) - (SyntaxExtension : functor (Syntax : Sig.Camlp4Syntax.S) -> Sig.Camlp4Syntax.S) + (Id : Sig.Id) + (SyntaxExtension : functor (Syntax : Sig.Camlp4Syntax) -> Sig.Camlp4Syntax) : sig end; (** {6 Registering Parsers} *) @@ -42,13 +42,13 @@ value register_sig_item_parser : parser_fun PreCast.Ast.sig_item -> unit; value register_parser : parser_fun PreCast.Ast.str_item -> parser_fun PreCast.Ast.sig_item -> unit; module Parser - (Id : Sig.Id.S) (Maker : functor (Ast : Sig.Ast.S) -> Sig.Parser.S with module Ast = Ast) : sig end; + (Id : Sig.Id) (Maker : functor (Ast : Sig.Ast) -> Sig.Parser with module Ast = Ast) : sig end; module OCamlParser - (Id : Sig.Id.S) (Maker : functor (Ast : Sig.Camlp4Ast.S) -> Sig.Parser.S with module Ast = Ast) : sig end; + (Id : Sig.Id) (Maker : functor (Ast : Sig.Camlp4Ast) -> Sig.Parser with module Ast = Ast) : sig end; module OCamlPreCastParser - (Id : Sig.Id.S) (Parser : Sig.Parser.S with module Ast = PreCast.Ast) : sig end; + (Id : Sig.Id) (Parser : Sig.Parser with module Ast = PreCast.Ast) : sig end; (** {6 Registering Printers} *) @@ -60,29 +60,29 @@ value register_sig_item_printer : printer_fun PreCast.Ast.sig_item -> unit; value register_printer : printer_fun PreCast.Ast.str_item -> printer_fun PreCast.Ast.sig_item -> unit; module Printer - (Id : Sig.Id.S) - (Maker : functor (Syn : Sig.Syntax.S) -> Sig.Printer.S with module Ast = Syn.Ast) : + (Id : Sig.Id) + (Maker : functor (Syn : Sig.Syntax) -> Sig.Printer with module Ast = Syn.Ast) : sig end; module OCamlPrinter - (Id : Sig.Id.S) - (Maker : functor (Syn : Sig.Camlp4Syntax.S) -> Sig.Printer.S with module Ast = Syn.Ast) : + (Id : Sig.Id) + (Maker : functor (Syn : Sig.Camlp4Syntax) -> Sig.Printer with module Ast = Syn.Ast) : sig end; module OCamlPreCastPrinter - (Id : Sig.Id.S) (Printer : Sig.Printer.S with module Ast = PreCast.Ast) : + (Id : Sig.Id) (Printer : Sig.Printer with module Ast = PreCast.Ast) : sig end; (** {6 Registering Filters} *) module AstFilter - (Id : Sig.Id.S) (Maker : functor (F : Sig.AstFilters.S) -> sig end) : sig end; + (Id : Sig.Id) (Maker : functor (F : Sig.AstFilters) -> sig end) : sig end; value declare_dyn_module : string -> (unit -> unit) -> unit; value iter_and_take_callbacks : ((string * (unit -> unit)) -> unit) -> unit; -module CurrentParser : Sig.Parser.S with module Ast = PreCast.Ast; -module CurrentPrinter : Sig.Printer.S with module Ast = PreCast.Ast; +module CurrentParser : Sig.Parser with module Ast = PreCast.Ast; +module CurrentPrinter : Sig.Printer with module Ast = PreCast.Ast; value enable_ocaml_printer : unit -> unit; value enable_ocamlr_printer : unit -> unit; diff --git a/camlp4/Camlp4/Struct/AstFilters.ml b/camlp4/Camlp4/Struct/AstFilters.ml index f04b6c8dc..9962d8a19 100644 --- a/camlp4/Camlp4/Struct/AstFilters.ml +++ b/camlp4/Camlp4/Struct/AstFilters.ml @@ -16,8 +16,8 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -module Make (Ast : Sig.Camlp4Ast.S) -: Sig.AstFilters.S with module Ast = Ast +module Make (Ast : Sig.Camlp4Ast) +: Sig.AstFilters with module Ast = Ast = struct module Ast = Ast; diff --git a/camlp4/Camlp4/Struct/Camlp4Ast.genmap.ml b/camlp4/Camlp4/Struct/Camlp4Ast.mlast index 529e5ff92..95bccdb5c 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast.genmap.ml +++ b/camlp4/Camlp4/Struct/Camlp4Ast.mlast @@ -17,13 +17,13 @@ * - Nicolas Pouillard: refactoring *) -module Make (Loc : Sig.Loc.S) -: Sig.Camlp4Ast.S with module Loc = Loc +module Make (Loc : Sig.Loc) +: Sig.Camlp4Ast with module Loc = Loc = struct module Loc = Loc; module Ast = struct - include Sig.Camlp4Ast.Make Loc; + include Sig.MakeCamlp4Ast Loc; value safe_string_escaped s = if String.length s > 2 && s.[0] = '\\' && s.[1] = '$' then s @@ -193,7 +193,7 @@ module Make (Loc : Sig.Loc.S) | <:expr< $_$ >> -> error () ] in fun [ <:expr< $id:i$ >> -> i - | <:expr@_loc< $e1$ $e2$ >> -> error () + | <:expr< $_$ $_$ >> -> error () | t -> self t ]; value ident_of_ctyp = @@ -391,7 +391,7 @@ module Make (Loc : Sig.Loc.S) [ <:binding< $b1$ and $b2$ >> -> pel_of_binding b1 @ pel_of_binding b2 | <:binding< $p$ = $e$ >> -> [(p, e)] | <:binding< $b1$ ; $b2$ >> -> pel_of_binding b1 @ pel_of_binding b2 - | t -> assert False ]; + | _ -> assert False ]; value rec list_of_binding x acc = match x with @@ -495,4 +495,7 @@ module Make (Loc : Sig.Loc.S) end; -#use "Camlp4/Struct/Camlp4Ast.tmp.ml"; +module Camlp4Trash = struct +(* #use "camlp4/Camlp4/Camlp4Ast.partial.ml"; *) + INCLUDE "camlp4/Camlp4/Camlp4Ast.partial.ml"; +end; diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml index a34fd04cb..02b894e79 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml +++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml @@ -20,7 +20,7 @@ (* $Id$ *) -module Make (Ast : Sig.Camlp4Ast.S) = struct +module Make (Ast : Sig.Camlp4Ast) = struct open Format; open Parsetree; open Longident; @@ -28,8 +28,8 @@ module Make (Ast : Sig.Camlp4Ast.S) = struct open Ast; value constructors_arity () = - debug ast2pt "constructors_arity: %b@." Config.constructors_arity.val in - Config.constructors_arity.val; + debug ast2pt "constructors_arity: %b@." Camlp4_config.constructors_arity.val in + Camlp4_config.constructors_arity.val; value error loc str = Loc.raise loc (Failure str); @@ -93,7 +93,7 @@ module Make (Ast : Sig.Camlp4Ast.S) = struct ; value array_function str name = - ldot (lident str) (if Config.unsafe.val then "unsafe_" ^ name else name) + ldot (lident str) (if Camlp4_config.unsafe.val then "unsafe_" ^ name else name) ; value mkrf = diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli index c9bd4a0d7..bd3c56039 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli +++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli @@ -21,7 +21,7 @@ (* $Id$ *) -module Make (Camlp4Ast : Sig.Camlp4Ast.S) : sig +module Make (Camlp4Ast : Sig.Camlp4Ast) : sig open Camlp4Ast; (** {6 Useful functions} *) diff --git a/camlp4/Camlp4/Struct/CleanAst.ml b/camlp4/Camlp4/Struct/CleanAst.ml index 03c4af187..0374ae282 100644 --- a/camlp4/Camlp4/Struct/CleanAst.ml +++ b/camlp4/Camlp4/Struct/CleanAst.ml @@ -17,7 +17,7 @@ *) (** This module is suppose to contain nils elimination. *) -module Make (Ast : Sig.Camlp4Ast.S) = struct +module Make (Ast : Sig.Camlp4Ast) = struct class clean_ast = object (self) diff --git a/camlp4/Camlp4/Struct/CommentFilter.ml b/camlp4/Camlp4/Struct/CommentFilter.ml index e7484fba9..5867df408 100644 --- a/camlp4/Camlp4/Struct/CommentFilter.ml +++ b/camlp4/Camlp4/Struct/CommentFilter.ml @@ -16,7 +16,7 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -module Make (Token : Sig.Camlp4Token.S) = struct +module Make (Token : Sig.Camlp4Token) = struct open Token; type t = (Stream.t (string * Loc.t) * Queue.t (string * Loc.t)); @@ -31,7 +31,7 @@ module Make (Token : Sig.Camlp4Token.S) = struct value filter (_, q) = let rec self = parser - [ [: ` (Sig.Camlp4Token.COMMENT x, loc); xs :] -> + [ [: ` (Sig.COMMENT x, loc); xs :] -> do { Queue.add (x, loc) q; debug comments "add: %S at %a@\n" x Loc.dump loc in self xs } diff --git a/camlp4/Camlp4/Struct/CommentFilter.mli b/camlp4/Camlp4/Struct/CommentFilter.mli index ebd3762d8..c1789c6c3 100644 --- a/camlp4/Camlp4/Struct/CommentFilter.mli +++ b/camlp4/Camlp4/Struct/CommentFilter.mli @@ -16,7 +16,7 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -module Make (Token : Sig.Camlp4Token.S) : sig +module Make (Token : Sig.Camlp4Token) : sig open Token; type t = 'abstract; diff --git a/camlp4/Camlp4/Struct/DynLoader.ml b/camlp4/Camlp4/Struct/DynLoader.ml index a57f2eca9..715a0d764 100644 --- a/camlp4/Camlp4/Struct/DynLoader.ml +++ b/camlp4/Camlp4/Struct/DynLoader.ml @@ -31,8 +31,13 @@ value fold_load_path x f acc = Queue.fold (fun x y -> f y x) acc x; value mk ?(ocaml_stdlib = True) ?(camlp4_stdlib = True) () = let q = Queue.create () in do { - if ocaml_stdlib then include_dir q Config.ocaml_standard_library else (); - if camlp4_stdlib then include_dir q Config.camlp4_standard_library else (); + if ocaml_stdlib then include_dir q Camlp4_config.ocaml_standard_library else (); + if camlp4_stdlib then do { + include_dir q Camlp4_config.camlp4_standard_library; + include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Parsers"); + include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Printers"); + include_dir q (Filename.concat Camlp4_config.camlp4_standard_library "Camlp4Filters"); + } else (); include_dir q "."; q }; diff --git a/camlp4/Camlp4/Struct/DynLoader.mli b/camlp4/Camlp4/Struct/DynLoader.mli index 578d32f2d..292b705b5 100644 --- a/camlp4/Camlp4/Struct/DynLoader.mli +++ b/camlp4/Camlp4/Struct/DynLoader.mli @@ -17,4 +17,4 @@ * - Nicolas Pouillard: refactoring *) -include Sig.DynLoader.S; +include Sig.DynLoader; diff --git a/camlp4/Camlp4/Struct/EmptyError.mli b/camlp4/Camlp4/Struct/EmptyError.mli index 93f885638..9d216623a 100644 --- a/camlp4/Camlp4/Struct/EmptyError.mli +++ b/camlp4/Camlp4/Struct/EmptyError.mli @@ -16,4 +16,4 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -include Sig.Error.S;
\ No newline at end of file +include Sig.Error;
\ No newline at end of file diff --git a/camlp4/Camlp4/Struct/EmptyPrinter.ml b/camlp4/Camlp4/Struct/EmptyPrinter.ml index f69636272..2cde4dde7 100644 --- a/camlp4/Camlp4/Struct/EmptyPrinter.ml +++ b/camlp4/Camlp4/Struct/EmptyPrinter.ml @@ -16,7 +16,7 @@ * - Nicolas Pouillard: initial version *) -module Make (Ast : Sig.Ast.S) = struct +module Make (Ast : Sig.Ast) = struct module Ast = Ast; value print_interf ?input_file:(_) ?output_file:(_) _ = failwith "No interface printer"; diff --git a/camlp4/Camlp4/Struct/EmptyPrinter.mli b/camlp4/Camlp4/Struct/EmptyPrinter.mli index 17b96e1bc..186d93015 100644 --- a/camlp4/Camlp4/Struct/EmptyPrinter.mli +++ b/camlp4/Camlp4/Struct/EmptyPrinter.mli @@ -16,4 +16,4 @@ * - Nicolas Pouillard: initial version *) -module Make (Ast : Sig.Ast.S) : Sig.Printer.S with module Ast = Ast; +module Make (Ast : Sig.Ast) : Sig.Printer with module Ast = Ast; diff --git a/camlp4/Camlp4/Struct/FreeVars.ml b/camlp4/Camlp4/Struct/FreeVars.ml index efdeea2d2..ffeae02fa 100644 --- a/camlp4/Camlp4/Struct/FreeVars.ml +++ b/camlp4/Camlp4/Struct/FreeVars.ml @@ -17,7 +17,7 @@ * - Nicolas Pouillard: initial version *) -module Make (Ast : Sig.Camlp4Ast.S) = struct +module Make (Ast : Sig.Camlp4Ast) = struct module S = Set.Make String; diff --git a/camlp4/Camlp4/Struct/FreeVars.mli b/camlp4/Camlp4/Struct/FreeVars.mli index f0d921e07..aac72db05 100644 --- a/camlp4/Camlp4/Struct/FreeVars.mli +++ b/camlp4/Camlp4/Struct/FreeVars.mli @@ -17,7 +17,7 @@ * - Nicolas Pouillard: initial version *) -module Make (Ast : Sig.Camlp4Ast.S) : sig +module Make (Ast : Sig.Camlp4Ast) : sig module S : Set.S with type elt = string; value fold_binding_vars : (string -> 'accu -> 'accu) -> Ast.binding -> 'accu -> 'accu; diff --git a/camlp4/Camlp4/Struct/Grammar/Context.ml b/camlp4/Camlp4/Struct/Grammar/Context.ml index 73d1a2f0c..fbd24134d 100644 --- a/camlp4/Camlp4/Struct/Grammar/Context.ml +++ b/camlp4/Camlp4/Struct/Grammar/Context.ml @@ -18,10 +18,10 @@ *) module type S = sig - module Token : Sig.Token.S; + module Token : Sig.Token; open Token; type t = 'abstract; - value mk : Stream.t (Token.t * Loc.t) -> t; + value call_with_ctx : Stream.t (Token.t * Loc.t) -> (t -> 'a) -> 'a; value loc_bp : t -> Loc.t; value loc_ep : t -> Loc.t; value stream : t -> Stream.t (Token.t * Loc.t); @@ -31,7 +31,7 @@ module type S = sig value bp : Stream.t (Token.t * Loc.t) -> Loc.t; end; -module Make (Token : Sig.Token.S) : S with module Token = Token = struct +module Make (Token : Sig.Token) : S with module Token = Token = struct module Token = Token; open Token; @@ -79,4 +79,12 @@ module Make (Token : Sig.Token.S) : S with module Token = Token = struct do { set_loc (List.assq strm streams.val); Stream.junk strm }; value bp strm = loc_bp (List.assq strm streams.val); + value call_with_ctx strm f = + let streams_v = streams.val in + let r = + try f (mk strm) with exc -> do { streams.val := streams_v; raise exc } + in + do { streams.val := streams_v; r } + ; + end; diff --git a/camlp4/Camlp4/Struct/Grammar/Delete.ml b/camlp4/Camlp4/Struct/Grammar/Delete.ml index b4f5acf75..49a45002e 100644 --- a/camlp4/Camlp4/Struct/Grammar/Delete.ml +++ b/camlp4/Camlp4/Struct/Grammar/Delete.ml @@ -16,6 +16,7 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) + module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Parser = Parser.Make Structure; diff --git a/camlp4/Camlp4/Struct/Grammar/Dynamic.ml b/camlp4/Camlp4/Struct/Grammar/Dynamic.ml index f024325b2..09b439706 100644 --- a/camlp4/Camlp4/Struct/Grammar/Dynamic.ml +++ b/camlp4/Camlp4/Struct/Grammar/Dynamic.ml @@ -16,8 +16,8 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -module Make (Lexer : Sig.Lexer.S) -: Sig.Grammar.Dynamic.S with module Loc = Lexer.Loc +module Make (Lexer : Sig.Lexer) +: Sig.Grammar.Dynamic with module Loc = Lexer.Loc and module Token = Lexer.Token = struct module Structure = Structure.Make Lexer; @@ -34,7 +34,7 @@ module Make (Lexer : Sig.Lexer.S) gfilter = Token.Filter.mk (Hashtbl.mem gkeywords); glexer = Lexer.mk (); warning_verbose = ref True; (* FIXME *) - error_verbose = Config.verbose + error_verbose = Camlp4_config.verbose }; value get_filter g = g.gfilter; diff --git a/camlp4/Camlp4/Struct/Grammar/Entry.ml b/camlp4/Camlp4/Struct/Grammar/Entry.ml index 18610eb97..8402672b8 100644 --- a/camlp4/Camlp4/Struct/Grammar/Entry.ml +++ b/camlp4/Camlp4/Struct/Grammar/Entry.ml @@ -16,6 +16,7 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) + module Make (Structure : Structure.S) = struct module Dump = Print.MakeDump Structure; module Print = Print.Make Structure; @@ -40,13 +41,14 @@ module Make (Structure : Structure.S) = struct edesc = Dlevels [] }; value action_parse entry ts : Action.t = - let c = Context.mk ts in - try entry.estart 0 c (Context.stream c) with - [ Stream.Failure -> - Loc.raise (Context.loc_ep c) - (Stream.Error ("illegal begin of " ^ entry.ename)) - | Loc.Exc_located _ _ as exc -> raise exc - | exc -> Loc.raise (Context.loc_ep c) exc ]; + Context.call_with_ctx ts + (fun c -> + try entry.estart 0 c (Context.stream c) with + [ Stream.Failure -> + Loc.raise (Context.loc_ep c) + (Stream.Error ("illegal begin of " ^ entry.ename)) + | Loc.Exc_located _ _ as exc -> raise exc + | exc -> Loc.raise (Context.loc_ep c) exc ]); value lex entry loc cs = entry.egram.glexer loc cs; diff --git a/camlp4/Camlp4/Struct/Grammar/Failed.ml b/camlp4/Camlp4/Struct/Grammar/Failed.ml index 2fecbb514..907d3378c 100644 --- a/camlp4/Camlp4/Struct/Grammar/Failed.ml +++ b/camlp4/Camlp4/Struct/Grammar/Failed.ml @@ -16,6 +16,7 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) + module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Search = Search.Make Structure; diff --git a/camlp4/Camlp4/Struct/Grammar/Fold.ml b/camlp4/Camlp4/Struct/Grammar/Fold.ml index 4d8c44c82..e59d86e3c 100644 --- a/camlp4/Camlp4/Struct/Grammar/Fold.ml +++ b/camlp4/Camlp4/Struct/Grammar/Fold.ml @@ -24,7 +24,7 @@ module Make (Structure : Structure.S) = struct open Format; module Parse = Parser.Make Structure; module Fail = Failed.Make Structure; - open Sig.Grammar.Structure; + open Sig.Grammar; module Stream = struct include Stream; diff --git a/camlp4/Camlp4/Struct/Grammar/Insert.ml b/camlp4/Camlp4/Struct/Grammar/Insert.ml index 4aa846be9..62d8a9727 100644 --- a/camlp4/Camlp4/Struct/Grammar/Insert.ml +++ b/camlp4/Camlp4/Struct/Grammar/Insert.ml @@ -1,3 +1,4 @@ +(* -*- camlp4r -*- *) (****************************************************************************) (* *) (* Objective Caml *) @@ -16,12 +17,13 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -module Make (Structure : Structure.S) = struct (* -*- camlp4r -*- *) + +module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Parser = Parser.Make Structure; open Structure; open Format; - open Sig.Grammar.Structure; + open Sig.Grammar; value is_before s1 s2 = match (s1, s2) with diff --git a/camlp4/Camlp4/Struct/Grammar/Parser.ml b/camlp4/Camlp4/Struct/Grammar/Parser.ml index 5231610a7..1934dc69c 100644 --- a/camlp4/Camlp4/Struct/Grammar/Parser.ml +++ b/camlp4/Camlp4/Struct/Grammar/Parser.ml @@ -16,12 +16,13 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) + module Make (Structure : Structure.S) = struct module Tools = Tools.Make Structure; module Failed = Failed.Make Structure; module Print = Print.Make Structure; open Structure; - open Sig.Grammar.Structure; + open Sig.Grammar; module Stream = struct include Stream; @@ -30,7 +31,7 @@ module Make (Structure : Structure.S) = struct end; value add_loc c bp parse_fun strm = - let x = parse_fun strm in + let x = parse_fun c strm in let ep = Context.loc_ep c in let loc = Loc.merge bp ep in (x, loc); @@ -87,11 +88,11 @@ module Make (Structure : Structure.S) = struct value do_recover parser_of_tree entry nlevn alevn loc a s c son = parser - [ [: a = parser_of_tree entry nlevn alevn c (top_tree entry son) :] -> a + [ [: a = parser_of_tree entry nlevn alevn (top_tree entry son) c :] -> a | [: a = skip_if_empty c loc (parser []) :] -> a | [: a = continue entry loc a s c son - (parser_of_tree entry nlevn alevn c son) :] -> + (parser_of_tree entry nlevn alevn son c) :] -> a ] ; @@ -110,17 +111,19 @@ module Make (Structure : Structure.S) = struct do_recover parser_of_tree entry nlevn alevn loc a s c son strm ; - value rec parser_of_tree entry nlevn alevn c = + value rec parser_of_tree entry nlevn alevn = fun - [ DeadEnd -> parser [] - | LocAct act _ -> parser [: :] -> act + [ DeadEnd -> fun _ -> parser [] + | LocAct act _ -> fun _ -> parser [: :] -> act | Node {node = Sself; son = LocAct act _; brother = DeadEnd} -> - parser [: a = entry.estart alevn c :] -> Action.getf act a + fun c -> + parser [: a = entry.estart alevn c :] -> Action.getf act a | Node {node = Sself; son = LocAct act _; brother = bro} -> - let p2 = parser_of_tree entry nlevn alevn c bro in - parser - [ [: a = entry.estart alevn c :] -> Action.getf act a - | [: a = p2 :] -> a ] + let p2 = parser_of_tree entry nlevn alevn bro in + fun c -> + parser + [ [: a = entry.estart alevn c :] -> Action.getf act a + | [: a = p2 c :] -> a ] | Node {node = s; son = son; brother = DeadEnd} -> let tokl = match s with @@ -129,14 +132,15 @@ module Make (Structure : Structure.S) = struct in match tokl with [ None -> - let ps = parser_of_symbol entry nlevn c s in - let p1 = parser_of_tree entry nlevn alevn c son in - let p1 = parser_cont p1 entry nlevn alevn s c son in - parser bp [: a = ps; act = p1 bp a :] -> Action.getf act a + let ps = parser_of_symbol entry nlevn s in + let p1 = parser_of_tree entry nlevn alevn son in + let p1 = parser_cont p1 entry nlevn alevn s son in + fun c -> + parser bp [: a = ps c; act = p1 c bp a :] -> Action.getf act a | Some (tokl, last_tok, son) -> - let p1 = parser_of_tree entry nlevn alevn c son in - let p1 = parser_cont p1 entry nlevn alevn last_tok c son in - parser_of_token_list p1 tokl c ] + let p1 = parser_of_tree entry nlevn alevn son in + let p1 = parser_cont p1 entry nlevn alevn last_tok son in + parser_of_token_list p1 tokl ] | Node {node = s; son = son; brother = bro} -> let tokl = match s with @@ -145,146 +149,163 @@ module Make (Structure : Structure.S) = struct in match tokl with [ None -> - let ps = parser_of_symbol entry nlevn c s in - let p1 = parser_of_tree entry nlevn alevn c son in - let p1 = parser_cont p1 entry nlevn alevn s c son in - let p2 = parser_of_tree entry nlevn alevn c bro in - parser bp - [ [: a = ps; act = p1 bp a :] -> Action.getf act a - | [: a = p2 :] -> a ] + let ps = parser_of_symbol entry nlevn s in + let p1 = parser_of_tree entry nlevn alevn son in + let p1 = parser_cont p1 entry nlevn alevn s son in + let p2 = parser_of_tree entry nlevn alevn bro in + fun c -> + parser bp + [ [: a = ps c; act = p1 c bp a :] -> Action.getf act a + | [: a = p2 c :] -> a ] | Some (tokl, last_tok, son) -> - let p1 = parser_of_tree entry nlevn alevn c son in - let p1 = parser_cont p1 entry nlevn alevn last_tok c son in - let p1 = parser_of_token_list p1 tokl c in - let p2 = parser_of_tree entry nlevn alevn c bro in - parser - [ [: a = p1 :] -> a - | [: a = p2 :] -> a ] ] ] - and parser_cont p1 entry nlevn alevn s c son loc a = + let p1 = parser_of_tree entry nlevn alevn son in + let p1 = parser_cont p1 entry nlevn alevn last_tok son in + let p1 = parser_of_token_list p1 tokl in + let p2 = parser_of_tree entry nlevn alevn bro in + fun c -> + parser + [ [: a = p1 c :] -> a + | [: a = p2 c :] -> a ] ] ] + and parser_cont p1 entry nlevn alevn s son c loc a = parser - [ [: a = p1 :] -> a + [ [: a = p1 c :] -> a | [: a = recover parser_of_tree entry nlevn alevn loc a s c son :] -> a | [: :] -> raise (Stream.Error (Failed.tree_failed entry a s son)) ] - and parser_of_token_list p1 tokl c = + and parser_of_token_list p1 tokl = loop 1 tokl where rec loop n = fun [ [Stoken (tematch, _) :: tokl] -> match tokl with [ [] -> - let ps _ = + let ps c _ = match Context.peek_nth c n with [ Some (tok, _) when tematch tok -> do { Context.njunk c n; Action.mk tok } | _ -> raise Stream.Failure ] - in parser bp [: a = ps; act = p1 bp a :] -> Action.getf act a + in + fun c -> + parser bp [: a = ps c; act = p1 c bp a :] -> Action.getf act a | _ -> - let ps _ = + let ps c _ = match Context.peek_nth c n with [ Some (tok, _) when tematch tok -> tok | _ -> raise Stream.Failure ] in let p1 = loop (n + 1) tokl in - parser [: tok = ps; s :] -> let act = p1 s in Action.getf act tok ] + fun c -> + parser [: tok = ps c; s :] -> + let act = p1 c s in Action.getf act tok ] | [Skeyword kwd :: tokl] -> match tokl with [ [] -> - let ps _ = + let ps c _ = match Context.peek_nth c n with [ Some (tok, _) when Token.match_keyword kwd tok -> do { Context.njunk c n; Action.mk tok } | _ -> raise Stream.Failure ] - in parser bp [: a = ps; act = p1 bp a :] -> Action.getf act a + in + fun c -> + parser bp [: a = ps c; act = p1 c bp a :] -> Action.getf act a | _ -> - let ps _ = + let ps c _ = match Context.peek_nth c n with [ Some (tok, _) when Token.match_keyword kwd tok -> tok | _ -> raise Stream.Failure ] in let p1 = loop (n + 1) tokl in - parser - [: tok = ps; s :] -> - let act = p1 s in Action.getf act tok ] + fun c -> + parser [: tok = ps c; s :] -> + let act = p1 c s in Action.getf act tok ] | _ -> invalid_arg "parser_of_token_list" ] - and parser_of_symbol entry nlevn c = + and parser_of_symbol entry nlevn = fun [ Smeta _ symbl act -> let act = Obj.magic act entry symbl in - Obj.magic - (List.fold_left - (fun act symb -> Obj.magic act (parser_of_symbol entry nlevn c symb)) - act symbl) + let pl = List.map (parser_of_symbol entry nlevn) symbl in + fun c -> + Obj.magic (List.fold_left (fun act p -> Obj.magic act (p c)) act pl) | Slist0 s -> - let ps = parser_of_symbol entry nlevn c s in - let rec loop al = + let ps = parser_of_symbol entry nlevn s in + let rec loop c al = parser - [ [: a = ps; s :] -> loop [a :: al] s + [ [: a = ps c; s :] -> loop c [a :: al] s | [: :] -> al ] in - parser [: a = loop [] :] -> Action.mk (List.rev a) + fun c -> parser [: a = loop c [] :] -> Action.mk (List.rev a) | Slist0sep symb sep -> - let ps = parser_of_symbol entry nlevn c symb in - let pt = parser_of_symbol entry nlevn c sep in - let rec kont al = + let ps = parser_of_symbol entry nlevn symb in + let pt = parser_of_symbol entry nlevn sep in + let rec kont c al = parser - [ [: v = pt; a = ps ?? Failed.symb_failed entry v sep symb; s :] -> - kont [a :: al] s + [ [: v = pt c; a = ps c ?? Failed.symb_failed entry v sep symb; + s :] -> + kont c [a :: al] s | [: :] -> al ] in - parser - [ [: a = ps; s :] -> Action.mk (List.rev (kont [a] s)) - | [: :] -> Action.mk [] ] + fun c -> + parser + [ [: a = ps c; s :] -> Action.mk (List.rev (kont c [a] s)) + | [: :] -> Action.mk [] ] | Slist1 s -> - let ps = parser_of_symbol entry nlevn c s in - let rec loop al = + let ps = parser_of_symbol entry nlevn s in + let rec loop c al = parser - [ [: a = ps; s :] -> loop [a :: al] s + [ [: a = ps c; s :] -> loop c [a :: al] s | [: :] -> al ] in - parser [: a = ps; s :] -> Action.mk (List.rev (loop [a] s)) + fun c -> + parser [: a = ps c; s :] -> Action.mk (List.rev (loop c [a] s)) | Slist1sep symb sep -> - let ps = parser_of_symbol entry nlevn c symb in - let pt = parser_of_symbol entry nlevn c sep in - let rec kont al = + let ps = parser_of_symbol entry nlevn symb in + let pt = parser_of_symbol entry nlevn sep in + let rec kont c al = parser - [ [: v = pt; + [ [: v = pt c; a = parser - [ [: a = ps :] -> a + [ [: a = ps c :] -> a | [: a = parse_top_symb' entry symb c :] -> a | [: :] -> raise (Stream.Error (Failed.symb_failed entry v sep symb)) ]; s :] -> - kont [a :: al] s + kont c [a :: al] s | [: :] -> al ] in - parser [: a = ps; s :] -> Action.mk (List.rev (kont [a] s)) + fun c -> + parser [: a = ps c; s :] -> Action.mk (List.rev (kont c [a] s)) | Sopt s -> - let ps = parser_of_symbol entry nlevn c s in - parser - [ [: a = ps :] -> Action.mk (Some a) - | [: :] -> Action.mk None ] + let ps = parser_of_symbol entry nlevn s in + fun c -> + parser + [ [: a = ps c :] -> Action.mk (Some a) + | [: :] -> Action.mk None ] | Stree t -> - let pt = parser_of_tree entry 1 0 c t in - parser bp [: (act, loc) = add_loc c bp pt :] -> Action.getf act loc - | Snterm e -> parser [: a = e.estart 0 c :] -> a - | Snterml e l -> parser [: a = e.estart (level_number e l) c :] -> a - | Sself -> parser [: a = entry.estart 0 c :] -> a - | Snext -> parser [: a = entry.estart nlevn c :] -> a + let pt = parser_of_tree entry 1 0 t in + fun c -> + parser bp [: (act, loc) = add_loc c bp pt :] -> + Action.getf act loc + | Snterm e -> fun c -> parser [: a = e.estart 0 c :] -> a + | Snterml e l -> + fun c -> parser [: a = e.estart (level_number e l) c :] -> a + | Sself -> fun c -> parser [: a = entry.estart 0 c :] -> a + | Snext -> fun c -> parser [: a = entry.estart nlevn c :] -> a | Skeyword kwd -> - parser - [: `(tok, _) when Token.match_keyword kwd tok :] -> Action.mk tok - | Stoken (f, _) -> parser [: `(tok, _) when f tok :] -> Action.mk tok ] + fun _ -> + parser + [: `(tok, _) when Token.match_keyword kwd tok :] -> Action.mk tok + | Stoken (f, _) -> + fun _ -> parser [: `(tok, _) when f tok :] -> Action.mk tok ] and parse_top_symb' entry symb c = - parser_of_symbol entry 0 c (top_symb entry symb) + parser_of_symbol entry 0 (top_symb entry symb) c and parse_top_symb entry symb = fun strm -> - let c = Context.mk strm - in parse_top_symb' entry symb c (Context.stream c); + Context.call_with_ctx strm + (fun c -> parse_top_symb' entry symb c (Context.stream c)); - value rec start_parser_of_levels entry clevn c = + value rec start_parser_of_levels entry clevn = fun - [ [] -> fun _ -> parser [] + [ [] -> fun _ _ -> parser [] | [lev :: levs] -> - let p1 = start_parser_of_levels entry (succ clevn) c levs in + let p1 = start_parser_of_levels entry (succ clevn) levs in match lev.lprefix with [ DeadEnd -> p1 | tree -> @@ -293,38 +314,37 @@ module Make (Structure : Structure.S) = struct [ LeftA | NonA -> succ clevn | RightA -> clevn ] in - let p2 = parser_of_tree entry (succ clevn) alevn c tree in + let p2 = parser_of_tree entry (succ clevn) alevn tree in match levs with [ [] -> - fun levn -> + fun levn c -> parser bp [: (act, loc) = add_loc c bp p2; strm :] -> let a = Action.getf act loc in entry.econtinue levn loc a c strm | _ -> - fun levn strm -> - if levn > clevn then p1 levn strm + fun levn c strm -> + if levn > clevn then p1 levn c strm else match strm with parser bp [ [: (act, loc) = add_loc c bp p2 :] -> let a = Action.getf act loc in entry.econtinue levn loc a c strm - | [: act = p1 levn :] -> act ] ] ] ] + | [: act = p1 levn c :] -> act ] ] ] ] ; value start_parser_of_entry entry = debug gram "start_parser_of_entry: @[<2>%a@]@." Print.entry entry in match entry.edesc with [ Dlevels [] -> Tools.empty_entry entry.ename - | Dlevels elev -> fun levn c -> - start_parser_of_levels entry 0 c elev levn + | Dlevels elev -> start_parser_of_levels entry 0 elev | Dparser p -> fun _ _ strm -> p strm ] ; - value rec continue_parser_of_levels entry clevn c = + value rec continue_parser_of_levels entry clevn = fun - [ [] -> fun _ _ _ -> parser [] + [ [] -> fun _ _ _ _ -> parser [] | [lev :: levs] -> - let p1 = continue_parser_of_levels entry (succ clevn) c levs in + let p1 = continue_parser_of_levels entry (succ clevn) levs in match lev.lsuffix with [ DeadEnd -> p1 | tree -> @@ -333,12 +353,12 @@ module Make (Structure : Structure.S) = struct [ LeftA | NonA -> succ clevn | RightA -> clevn ] in - let p2 = parser_of_tree entry (succ clevn) alevn c tree in - fun levn bp a strm -> - if levn > clevn then p1 levn bp a strm + let p2 = parser_of_tree entry (succ clevn) alevn tree in + fun c levn bp a strm -> + if levn > clevn then p1 c levn bp a strm else match strm with parser bp - [ [: act = p1 levn bp a :] -> act + [ [: act = p1 c levn bp a :] -> act | [: (act, loc) = add_loc c bp p2 :] -> let a = Action.getf2 act a loc in entry.econtinue levn loc a c strm ] ] ] @@ -348,10 +368,10 @@ module Make (Structure : Structure.S) = struct debug gram "continue_parser_of_entry: @[<2>%a@]@." Print.entry entry in match entry.edesc with [ Dlevels elev -> - let p = continue_parser_of_levels entry 0 in + let p = continue_parser_of_levels entry 0 elev in fun levn bp a c -> parser - [ [: a = p c elev levn bp a :] -> a + [ [: a = p c levn bp a :] -> a | [: :] -> a ] | Dparser _ -> fun _ _ _ _ -> parser [] ] ; diff --git a/camlp4/Camlp4/Struct/Grammar/Print.ml b/camlp4/Camlp4/Struct/Grammar/Print.ml index c55b936bb..dadf4aed2 100644 --- a/camlp4/Camlp4/Struct/Grammar/Print.ml +++ b/camlp4/Camlp4/Struct/Grammar/Print.ml @@ -16,10 +16,11 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) + module Make (Structure : Structure.S) = struct open Structure; open Format; - open Sig.Grammar.Structure; + open Sig.Grammar; value rec flatten_tree = fun @@ -134,7 +135,7 @@ end; module MakeDump (Structure : Structure.S) = struct open Structure; open Format; - open Sig.Grammar.Structure; + open Sig.Grammar; type brothers = [ Bro of symbol and list brothers ]; diff --git a/camlp4/Camlp4/Struct/Grammar/Static.ml b/camlp4/Camlp4/Struct/Grammar/Static.ml index 60651a47c..b20eed779 100644 --- a/camlp4/Camlp4/Struct/Grammar/Static.ml +++ b/camlp4/Camlp4/Struct/Grammar/Static.ml @@ -16,8 +16,8 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -module Make (Lexer : Sig.Lexer.S) -: Sig.Grammar.Static.S with module Loc = Lexer.Loc +module Make (Lexer : Sig.Lexer) +: Sig.Grammar.Static with module Loc = Lexer.Loc and module Token = Lexer.Token = struct module Structure = Structure.Make Lexer; @@ -33,7 +33,7 @@ module Make (Lexer : Sig.Lexer.S) gfilter = Token.Filter.mk (Hashtbl.mem gkeywords); glexer = Lexer.mk (); warning_verbose = ref True; (* FIXME *) - error_verbose = Config.verbose + error_verbose = Camlp4_config.verbose }; module Entry = struct diff --git a/camlp4/Camlp4/Struct/Grammar/Structure.ml b/camlp4/Camlp4/Struct/Grammar/Structure.ml index 278da4079..12023b7d1 100644 --- a/camlp4/Camlp4/Struct/Grammar/Structure.ml +++ b/camlp4/Camlp4/Struct/Grammar/Structure.ml @@ -16,15 +16,17 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -open Sig.Grammar.Structure; + +open Sig.Grammar; + module type S = sig - module Loc : Sig.Loc.S; - module Token : Sig.Token.S with module Loc = Loc; - module Lexer : Sig.Lexer.S + module Loc : Sig.Loc; + module Token : Sig.Token with module Loc = Loc; + module Lexer : Sig.Lexer with module Loc = Loc and module Token = Token; module Context : Context.S with module Token = Token; - module Action : Sig.Grammar.Action.S; + module Action : Sig.Grammar.Action; type gram = { gfilter : Token.Filter.t; @@ -97,10 +99,10 @@ module type S = sig value removing : gram -> string -> unit; end; -module Make (Lexer : Sig.Lexer.S) = struct +module Make (Lexer : Sig.Lexer) = struct module Loc = Lexer.Loc; module Token = Lexer.Token; - module Action : Sig.Grammar.Action.S = struct + module Action : Sig.Grammar.Action = struct type t = Obj.t ; value mk = Obj.repr; value get = Obj.obj ; diff --git a/camlp4/Camlp4/Struct/Lexer.mll b/camlp4/Camlp4/Struct/Lexer.mll index 3aa381a63..87cb362ae 100644 --- a/camlp4/Camlp4/Struct/Lexer.mll +++ b/camlp4/Camlp4/Struct/Lexer.mll @@ -27,7 +27,7 @@ (** A lexical analyzer. *) -(* FIXME interface module Make (Token : Token.S) |+ Note that this Token sig is not in Sig +| *) +(* FIXME interface module Make (Token : Token) |+ Note that this Token sig is not in Sig +| *) (* : Sig.Lexer. S with module Loc = Token.Loc and module Token = Token; *) (* type context = @@ -48,14 +48,13 @@ value mk' : context -> Stream.t char -> Stream.t (Token.t * Loc.t); *) module TokenEval = Token.Eval -module Make (Token : Sig.Camlp4Token.S) +module Make (Token : Sig.Camlp4Token) = struct module Loc = Token.Loc module Token = Token open Lexing - open Sig.Camlp4Token - open Sig.Quotation + open Sig (* Error report *) module Error = struct @@ -428,6 +427,6 @@ module Make (Token : Sig.Camlp4Token.S) from_lexbuf ?quotations lb let mk () loc strm = - from_stream ~quotations:!Config.quotations loc strm + from_stream ~quotations:!Camlp4_config.quotations loc strm end } diff --git a/camlp4/Camlp4/Struct/Loc.mli b/camlp4/Camlp4/Struct/Loc.mli index d1a92ce0f..e90161938 100644 --- a/camlp4/Camlp4/Struct/Loc.mli +++ b/camlp4/Camlp4/Struct/Loc.mli @@ -16,4 +16,4 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -include Sig.Loc.S; +include Sig.Loc; diff --git a/camlp4/Camlp4/Struct/Quotation.ml b/camlp4/Camlp4/Struct/Quotation.ml index 2d1086ea4..b27f53c30 100644 --- a/camlp4/Camlp4/Struct/Quotation.ml +++ b/camlp4/Camlp4/Struct/Quotation.ml @@ -21,13 +21,13 @@ (* $Id$ *) -module Make (Ast : Sig.Ast.S) -: Sig.Quotation.S with module Ast = Ast +module Make (Ast : Sig.Ast) +: Sig.Quotation with module Ast = Ast = struct module Ast = Ast; module Loc = Ast.Loc; open Format; - open Sig.Quotation; + open Sig; type expand_fun 'a = Loc.t -> option string -> string -> 'a; diff --git a/camlp4/Camlp4/Struct/Token.ml b/camlp4/Camlp4/Struct/Token.ml index 0cbf78420..7037888a1 100644 --- a/camlp4/Camlp4/Struct/Token.ml +++ b/camlp4/Camlp4/Struct/Token.ml @@ -18,13 +18,12 @@ open Format; -module Make (Loc : Sig.Loc.S) -: Sig.Camlp4Token.S with module Loc = Loc +module Make (Loc : Sig.Loc) +: Sig.Camlp4Token with module Loc = Loc = struct module Loc = Loc; - open Sig.Quotation; - open Sig.Camlp4Token; - type t = Sig.Camlp4Token.t; + open Sig; + type t = camlp4_token; type token = t; value to_string = @@ -97,7 +96,7 @@ module Make (Loc : Sig.Loc.S) let module M = ErrorHandler.Register Error in (); module Filter = struct - type token_filter = Sig.Token.stream_filter t Loc.t; + type token_filter = stream_filter t Loc.t; type t = { is_kwd : string -> bool; diff --git a/camlp4/Camlp4/Struct/Token.mli b/camlp4/Camlp4/Struct/Token.mli index 5c7c248e6..812df0e00 100644 --- a/camlp4/Camlp4/Struct/Token.mli +++ b/camlp4/Camlp4/Struct/Token.mli @@ -17,7 +17,7 @@ * - Nicolas Pouillard: refactoring *) -module Make (Loc : Sig.Loc.S) : Sig.Camlp4Token.S with module Loc = Loc; +module Make (Loc : Sig.Loc) : Sig.Camlp4Token with module Loc = Loc; module Eval : sig value char : string -> char; diff --git a/camlp4/Camlp4/Struct/Warning.ml b/camlp4/Camlp4/Struct/Warning.ml index 369670338..dbb04008e 100644 --- a/camlp4/Camlp4/Struct/Warning.ml +++ b/camlp4/Camlp4/Struct/Warning.ml @@ -16,7 +16,7 @@ * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring *) -module Make (Loc : Sig.Loc.S) : Sig.Warning.S with module Loc = Loc = struct +module Make (Loc : Sig.Loc) : Sig.Warning with module Loc = Loc = struct module Loc = Loc; open Format; type t = Loc.t -> string -> unit; diff --git a/camlp4/Camlp4Bin.ml b/camlp4/Camlp4Bin.ml index ef555dd55..09895020b 100644 --- a/camlp4/Camlp4Bin.ml +++ b/camlp4/Camlp4Bin.ml @@ -27,17 +27,17 @@ open Format; module CleanAst = Camlp4.Struct.CleanAst.Make Ast; module SSet = Set.Make String; -value pa_r = "Camlp4Parsers.OCamlr"; -(* value pa_rr = "Camlp4Parsers.OCamlrr"; *) -value pa_o = "Camlp4Parsers.OCaml"; -value pa_rp = "Camlp4Parsers.OCamlRevisedParser"; -value pa_op = "Camlp4Parsers.OCamlParser"; -value pa_g = "Camlp4Parsers.Grammar"; -value pa_m = "Camlp4Parsers.Macro"; -value pa_qb = "Camlp4Parsers.OCamlQuotationBase"; -value pa_q = "Camlp4Parsers.OCamlQuotation"; -value pa_rq = "Camlp4Parsers.OCamlRevisedQuotation"; -value pa_oq = "Camlp4Parsers.OCamlOriginalQuotation"; +value pa_r = "Camlp4OCamlRevisedParser"; +(* value pa_rr = "Camlp4OCamlrrParser"; *) +value pa_o = "Camlp4OCamlParser"; +value pa_rp = "Camlp4OCamlRevisedParserParser"; +value pa_op = "Camlp4OCamlParserParser"; +value pa_g = "Camlp4GrammarParser"; +value pa_m = "Camlp4MacroParser"; +value pa_qb = "Camlp4QuotationCommon"; +value pa_q = "Camlp4QuotationExpander"; +value pa_rq = "Camlp4OCamlRevisedQuotationExpander"; +value pa_oq = "Camlp4OCamlOriginalQuotationExpander"; value dyn_loader = ref (fun []); value rcall_callback = ref (fun () -> ()); @@ -45,15 +45,6 @@ value loaded_modules = ref SSet.empty; value add_to_loaded_modules name = loaded_modules.val := SSet.add name loaded_modules.val; -value file_of_module_name n = - let s = String.copy n in - let rec self pos = - try do { - let pos = String.index_from s pos '.'; - s.[pos] := '/'; - } with [ Not_found -> () ] - in do { self 0; s ^ ".cmo" }; - value rewrite_and_load n x = let dyn_loader = dyn_loader.val () in let find_in_path = DynLoader.find_in_path dyn_loader in @@ -65,35 +56,43 @@ value rewrite_and_load n x = if SSet.mem n loaded_modules.val then () else do { add_to_loaded_modules n; - DynLoader.load dyn_loader (file_of_module_name n); + DynLoader.load dyn_loader (n ^ ".cmo"); }) in do { - match (n, x) with - [ ("Parsers"|"", "pa_r.cmo" | "r" | "OCamlr") -> load [pa_r] + match (n, String.lowercase x) with + [ ("Parsers"|"", "pa_r.cmo" | "r" | "ocamlr" | "ocamlrevised" | "camlp4ocamlrevisedparser.cmo") -> load [pa_r] (* | ("Parsers"|"", "rr" | "OCamlrr") -> load [pa_r; pa_rr] *) - | ("Parsers"|"", "pa_o.cmo" | "o" | "OCaml") -> load [pa_r; pa_o] - | ("Parsers"|"", "pa_rp.cmo" | "rp" | "OCamlRevisedParser") -> load [pa_r; pa_o; pa_rp] - | ("Parsers"|"", "pa_op.cmo" | "op" | "OCamlParser") -> load [pa_r; pa_o; pa_rp; pa_op] - | ("Parsers"|"", "pa_extend.cmo" | "pa_extend_m.cmo" | "g" | "Grammar") -> load [pa_r; pa_g] - | ("Parsers"|"", "pa_macro.cmo" | "m" | "Macro") -> load [pa_r; pa_m] - | ("Parsers"|"", "q" | "OCamlQuotation") -> load [pa_r; pa_qb; pa_q] - | ("Parsers"|"", "q_MLast.cmo" | "rq" | "OCamlRevisedQuotation") -> load [pa_r; pa_qb; pa_rq] - | ("Parsers"|"", "oq" | "OCamlOriginalQuotation") -> load [pa_r; pa_o; pa_qb; pa_oq] + | ("Parsers"|"", "pa_o.cmo" | "o" | "ocaml" | "camlp4ocamlparser.cmo") -> load [pa_r; pa_o] + | ("Parsers"|"", "pa_rp.cmo" | "rp" | "rparser" | "camlp4ocamlrevisedparserparser.cmo") -> load [pa_r; pa_o; pa_rp] + | ("Parsers"|"", "pa_op.cmo" | "op" | "parser" | "camlp4ocamlparserparser.cmo") -> load [pa_r; pa_o; pa_rp; pa_op] + | ("Parsers"|"", "pa_extend.cmo" | "pa_extend_m.cmo" | "g" | "grammar" | "camlp4grammarparser.cmo") -> load [pa_r; pa_g] + | ("Parsers"|"", "pa_macro.cmo" | "m" | "macro" | "camlp4macroparser.cmo") -> load [pa_r; pa_m] + | ("Parsers"|"", "q" | "camlp4quotationexpander.cmo") -> load [pa_r; pa_qb; pa_q] + | ("Parsers"|"", "q_MLast.cmo" | "rq" | "camlp4ocamlrevisedquotationexpander.cmo") -> load [pa_r; pa_qb; pa_rq] + | ("Parsers"|"", "oq" | "camlp4ocamloriginalquotationexpander.cmo") -> load [pa_r; pa_o; pa_qb; pa_oq] | ("Parsers"|"", "rf") -> load [pa_r; pa_rp; pa_qb; pa_q; pa_g; pa_m] | ("Parsers"|"", "of") -> load [pa_r; pa_o; pa_rp; pa_op; pa_qb; pa_rq; pa_g; pa_m] - | ("Filters"|"", "l" | "Lift" | "lift") -> load ["Camlp4Filters.LiftCamlp4Ast"] - | ("Printers"|"", "pr_r.cmo" | "r" | "OCamlr" | "Camlp4Printers/OCamlr.cmo") -> + | ("Filters"|"", "lift" | "camlp4astlifter.cmo") -> load ["Camlp4AstLifter"] + | ("Filters"|"", "exn" | "camlp4exceptiontracer.cmo") -> load ["Camlp4ExceptionTracer"] + | ("Filters"|"", "prof" | "camlp4profiler.cmo") -> load ["Camlp4Profiler"] + | ("Filters"|"", "map" | "camlp4mapgenerator.cmo") -> load ["Camlp4MapGenerator"] + | ("Filters"|"", "fold" | "camlp4foldgenerator.cmo") -> load ["Camlp4FoldGenerator"] + | ("Filters"|"", "meta" | "camlp4metagenerator.cmo") -> load ["Camlp4MetaGenerator"] + | ("Filters"|"", "trash" | "camlp4trashremover.cmo") -> load ["Camlp4TrashRemover"] + | ("Filters"|"", "striploc" | "camlp4locationstripper.cmo") -> load ["Camlp4LocationStripper"] + | ("Filters"|"", "tracer" | "camlp4tracer.cmo") -> load ["Camlp4Tracer"] + | ("Printers"|"", "pr_r.cmo" | "r" | "ocamlr" | "camlp4ocamlrevisedprinter.cmo") -> Register.enable_ocamlr_printer () (* | ("Printers"|"", "rr" | "OCamlrr" | "Camlp4Printers/OCamlrr.cmo") -> *) (* Register.enable_ocamlrr_printer () *) - | ("Printers"|"", "pr_o.cmo" | "o" | "OCaml" | "Camlp4Printers/OCaml.cmo") -> + | ("Printers"|"", "pr_o.cmo" | "o" | "ocaml" | "camlp4ocamlprinter.cmo") -> Register.enable_ocaml_printer () - | ("Printers"|"", "pr_dump.cmo" | "p" | "DumpOCamlAst" | "Camlp4Printers/DumpOCamlAst.cmo") -> + | ("Printers"|"", "pr_dump.cmo" | "p" | "dumpocaml" | "camlp4ocamlastdumper.cmo") -> Register.enable_dump_ocaml_ast_printer () - | ("Printers"|"", "d" | "DumpCamlp4Ast" | "Camlp4Printers/DumpCamlp4Ast.cmo") -> + | ("Printers"|"", "d" | "dumpcamlp4" | "camlp4astdumper.cmo") -> Register.enable_dump_camlp4_ast_printer () - | ("Printers"|"", "a" | "Auto" | "Camlp4Printers/Auto.cmo") -> - load ["Camlp4Printers.Auto"] + | ("Printers"|"", "a" | "auto" | "camlp4autoprinter.cmo") -> + load ["Camlp4AutoPrinter"] | _ -> let y = "Camlp4"^n^"/"^x^".cmo" in real_load (try find_in_path y with [ Not_found -> x ]) ]; @@ -157,13 +156,13 @@ value process_impl dyn_loader name = AstFilters.fold_implem_filters gimd; value just_print_the_version () = - do { printf "%s@." Config.version; exit 0 }; + do { printf "%s@." Camlp4_config.version; exit 0 }; value print_version () = - do { eprintf "Camlp4 version %s@." Config.version; exit 0 }; + do { eprintf "Camlp4 version %s@." Camlp4_config.version; exit 0 }; value print_stdlib () = - do { printf "%s@." Config.camlp4_standard_library; exit 0 }; + do { printf "%s@." Camlp4_config.camlp4_standard_library; exit 0 }; value usage ini_sl ext_sl = do { @@ -205,7 +204,7 @@ value print_loaded_modules = ref False; value (task, do_task) = let t = ref None in let task f x = - let () = Config.current_input_file.val := x in + let () = Camlp4_config.current_input_file.val := x in t.val := Some (if t.val = None then (fun _ -> f x) else (fun usage -> usage ())) in let do_task usage = match t.val with [ Some f -> f usage | None -> () ] in @@ -241,11 +240,11 @@ value initial_spec_list = "<file> Parse <file> as an implementation, whatever its extension."); ("-str", Arg.String (fun x -> input_file (Str x)), "<string> Parse <string> as an implementation."); - ("-unsafe", Arg.Set Config.unsafe, + ("-unsafe", Arg.Set Camlp4_config.unsafe, "Generate unsafe accesses to array and strings."); ("-noassert", Arg.Unit warn_noassert, "Obsolete, do not use this option."); - ("-verbose", Arg.Set Config.verbose, + ("-verbose", Arg.Set Camlp4_config.verbose, "More verbose in parsing errors."); ("-loc", Arg.Set_string Loc.name, "<name> Name of the location variable (default: " ^ Loc.name.val ^ ")."); @@ -257,7 +256,7 @@ value initial_spec_list = "Print Camlp4 version and exit."); ("-version", Arg.Unit just_print_the_version, "Print Camlp4 version number and exit."); - ("-no_quot", Arg.Clear Config.quotations, + ("-no_quot", Arg.Clear Camlp4_config.quotations, "Don't parse quotations, allowing to use, e.g. \"<:>\" as token."); ("-loaded-modules", Arg.Set print_loaded_modules, "Print the list of loaded modules."); ("-parser", Arg.String (rewrite_and_load "Parsers"), diff --git a/camlp4/Camlp4Filters/LiftCamlp4Ast.ml b/camlp4/Camlp4Filters/Camlp4AstLifter.ml index 6299f2ef7..335fbb0e2 100644 --- a/camlp4/Camlp4Filters/LiftCamlp4Ast.ml +++ b/camlp4/Camlp4Filters/Camlp4AstLifter.ml @@ -21,11 +21,11 @@ open Camlp4; module Id = struct - value name = "Camlp4Filters.LiftCamlp4Ast"; + value name = "Camlp4AstLifter"; value version = "$Id$"; end; -module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct +module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; module MetaLoc = struct diff --git a/camlp4/Camlp4Filters/ExceptionTracer.ml b/camlp4/Camlp4Filters/Camlp4ExceptionTracer.ml index 21c930162..96fe8c924 100644 --- a/camlp4/Camlp4Filters/ExceptionTracer.ml +++ b/camlp4/Camlp4Filters/Camlp4ExceptionTracer.ml @@ -21,11 +21,11 @@ open Camlp4; module Id = struct - value name = "Camlp4Filters.ExceptionTracer"; + value name = "Camlp4ExceptionTracer"; value version = "$Id$"; end; -module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct +module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; open Ast; @@ -49,14 +49,19 @@ module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct <:match_case< $map_match_case m1$ | $map_match_case m2$ >> | <:match_case@_loc< $p$ when $w$ -> $e$ >> -> <:match_case@_loc< $p$ when $w$ -> $add_debug_expr e$ >> - | m -> m ] + | m -> m ]; - and map_expr = - fun + value filter = object + inherit Ast.map as super; + method expr = fun [ <:expr@_loc< fun [ $m$ ] >> -> <:expr< fun [ $map_match_case m$ ] >> - | x -> x ]; + | x -> super#expr x ]; + method str_item = fun + [ <:str_item< module Debug = $_$ >> as st -> st + | st -> super#str_item st ]; + end; - register_str_item_filter (new Ast.c_expr map_expr)#str_item; + register_str_item_filter filter#str_item; end; diff --git a/camlp4/Camlp4Filters/GenerateFold.ml b/camlp4/Camlp4Filters/Camlp4FoldGenerator.ml index 377eeb11a..ad6ed45af 100644 --- a/camlp4/Camlp4Filters/GenerateFold.ml +++ b/camlp4/Camlp4Filters/Camlp4FoldGenerator.ml @@ -21,11 +21,11 @@ open Camlp4; module Id = struct - value name = "Camlp4Filters.GenerateFold"; + value name = "Camlp4FoldGenerator"; value version = "$Id$"; end; -module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct +module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; module StringMap = Map.Make String; open Ast; diff --git a/camlp4/Camlp4Filters/StripLocations.ml b/camlp4/Camlp4Filters/Camlp4LocationStripper.ml index fc5f0195d..c57e68673 100644 --- a/camlp4/Camlp4Filters/StripLocations.ml +++ b/camlp4/Camlp4Filters/Camlp4LocationStripper.ml @@ -21,11 +21,11 @@ open Camlp4; module Id = struct - value name = "Camlp4Filters.StripLocations"; + value name = "Camlp4LocationStripper"; value version = "$Id$"; end; -module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct +module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; open Ast; diff --git a/camlp4/Camlp4Filters/GenerateMap.ml b/camlp4/Camlp4Filters/Camlp4MapGenerator.ml index 09dc0159f..2270f52b5 100644 --- a/camlp4/Camlp4Filters/GenerateMap.ml +++ b/camlp4/Camlp4Filters/Camlp4MapGenerator.ml @@ -21,11 +21,11 @@ open Camlp4; module Id = struct - value name = "Camlp4Filters.GenerateMap"; + value name = "Camlp4MapGenerator"; value version = "$Id$"; end; -module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct +module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; module StringMap = Map.Make String; open Ast; diff --git a/camlp4/Camlp4Filters/MetaGenerator.ml b/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml index ebc14fc80..a62cc8c99 100644 --- a/camlp4/Camlp4Filters/MetaGenerator.ml +++ b/camlp4/Camlp4Filters/Camlp4MetaGenerator.ml @@ -1,4 +1,5 @@ -open Camlp4.PreCast; +open Camlp4; +open PreCast; module MapTy = Map.Make String; type t = diff --git a/camlp4/Camlp4Filters/Profiler.ml b/camlp4/Camlp4Filters/Camlp4Profiler.ml index 6ddb4628a..17e7a4c12 100644 --- a/camlp4/Camlp4Filters/Profiler.ml +++ b/camlp4/Camlp4Filters/Camlp4Profiler.ml @@ -20,11 +20,11 @@ open Camlp4; module Id = struct - value name = "Camlp4Filters.Profiler"; + value name = "Camlp4Profiler"; value version = "$Id$"; end; -module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct +module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; open Ast; @@ -57,7 +57,7 @@ module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct let _loc = Ast.loc_of_expr e in let () = Format.bprintf buf "%s @@ %a@?" id Loc.dump _loc in let s = Buffer.contents buf in - <:expr< let () = Camlp4Profiler.count $`str:s$ in $e$ >>; + <:expr< let () = Camlp4prof.count $`str:s$ in $e$ >>; value rec decorate_fun id = let decorate = decorate decorate_fun in diff --git a/camlp4/Camlp4Filters/Tracer.ml b/camlp4/Camlp4Filters/Camlp4Tracer.ml index a34461a90..a7cf5ca53 100644 --- a/camlp4/Camlp4Filters/Tracer.ml +++ b/camlp4/Camlp4Filters/Camlp4Tracer.ml @@ -21,11 +21,11 @@ open Camlp4; module Id = struct - value name = "Camlp4Filters.Tracer"; + value name = "Camlp4Tracer"; value version = "$Id$"; end; -module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct +module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; open Ast; diff --git a/camlp4/Camlp4Filters/RemoveTrashModule.ml b/camlp4/Camlp4Filters/Camlp4TrashRemover.ml index dfc33132f..b5b1a8622 100644 --- a/camlp4/Camlp4Filters/RemoveTrashModule.ml +++ b/camlp4/Camlp4Filters/Camlp4TrashRemover.ml @@ -21,18 +21,18 @@ open Camlp4; module Id = struct - value name = "Camlp4Filters.RemoveTrashModule"; + value name = "Camlp4TrashRemover"; value version = "$Id$"; end; -module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct +module Make (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; open Ast; register_str_item_filter (new Ast.c_str_item (fun - [ <:str_item@_loc< module Camlp4FiltersTrash = $_$ >> -> + [ <:str_item@_loc< module Camlp4Trash = $_$ >> -> <:str_item<>> | st -> st ]))#str_item; diff --git a/camlp4/Camlp4Parsers/LoadCamlp4Ast.ml b/camlp4/Camlp4Parsers/Camlp4AstLoader.ml index 0672ecb20..2e6d36fde 100644 --- a/camlp4/Camlp4Parsers/LoadCamlp4Ast.ml +++ b/camlp4/Camlp4Parsers/Camlp4AstLoader.ml @@ -19,11 +19,11 @@ open Camlp4; (* -*- camlp4r -*- *) module Id = struct - value name = "Camlp4Parsers.LoadCamlp4Ast"; + value name = "Camlp4AstLoader"; value version = "$Id$"; end; -module Make (Ast : Camlp4.Sig.Ast.S) = struct +module Make (Ast : Camlp4.Sig.Ast) = struct module Ast = Ast; value parse ast_magic ?directive_handler:(_) _loc strm = @@ -41,8 +41,8 @@ module Make (Ast : Camlp4.Sig.Ast.S) = struct }; open Camlp4.PreCast; - value parse_implem = parse Config.camlp4_ast_impl_magic_number; - value parse_interf = parse Config.camlp4_ast_intf_magic_number; + value parse_implem = parse Camlp4_config.camlp4_ast_impl_magic_number; + value parse_interf = parse Camlp4_config.camlp4_ast_intf_magic_number; end; diff --git a/camlp4/Camlp4Parsers/Debug.ml b/camlp4/Camlp4Parsers/Camlp4DebugParser.ml index 2e8533c75..25a0880be 100644 --- a/camlp4/Camlp4Parsers/Debug.ml +++ b/camlp4/Camlp4Parsers/Camlp4DebugParser.ml @@ -18,12 +18,12 @@ open Camlp4; (* -*- camlp4r -*- *) *) module Id = struct - value name = "Camlp4Parsers.Debug"; + value name = "Camlp4DebugParser"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct - open Sig.Camlp4Token; +module Make (Syntax : Sig.Camlp4Syntax) = struct + open Sig; include Syntax; module StringSet = Set.Make String; diff --git a/camlp4/Camlp4Parsers/Grammar.ml b/camlp4/Camlp4Parsers/Camlp4GrammarParser.ml index f523eaf2d..8bae3c382 100644 --- a/camlp4/Camlp4Parsers/Grammar.ml +++ b/camlp4/Camlp4Parsers/Camlp4GrammarParser.ml @@ -20,12 +20,12 @@ open Camlp4; (* -*- camlp4r -*- *) module Id = struct - value name = "Camlp4Parsers.Grammar"; + value name = "Camlp4GrammarParser"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct - open Sig.Camlp4Token; +module Make (Syntax : Sig.Camlp4Syntax) = struct + open Sig; include Syntax; module MetaLoc = Ast.Meta.MetaGhostLoc; @@ -689,11 +689,11 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct {name = n; pos = pos; levels = ll} ] ] ; position: - [ [ UIDENT "FIRST" -> <:expr< Camlp4.Sig.Grammar.Structure.First >> - | UIDENT "LAST" -> <:expr< Camlp4.Sig.Grammar.Structure.Last >> - | UIDENT "BEFORE"; n = string -> <:expr< Camlp4.Sig.Grammar.Structure.Before $n$ >> - | UIDENT "AFTER"; n = string -> <:expr< Camlp4.Sig.Grammar.Structure.After $n$ >> - | UIDENT "LEVEL"; n = string -> <:expr< Camlp4.Sig.Grammar.Structure.Level $n$ >> ] ] + [ [ UIDENT "FIRST" -> <:expr< Camlp4.Sig.Grammar.First >> + | UIDENT "LAST" -> <:expr< Camlp4.Sig.Grammar.Last >> + | UIDENT "BEFORE"; n = string -> <:expr< Camlp4.Sig.Grammar.Before $n$ >> + | UIDENT "AFTER"; n = string -> <:expr< Camlp4.Sig.Grammar.After $n$ >> + | UIDENT "LEVEL"; n = string -> <:expr< Camlp4.Sig.Grammar.Level $n$ >> ] ] ; level_list: [ [ "["; ll = LIST0 level SEP "|"; "]" -> ll ] ] @@ -703,9 +703,9 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct {label = lab; assoc = ass; rules = rules} ] ] ; assoc: - [ [ UIDENT "LEFTA" -> <:expr< Camlp4.Sig.Grammar.Structure.LeftA >> - | UIDENT "RIGHTA" -> <:expr< Camlp4.Sig.Grammar.Structure.RightA >> - | UIDENT "NONA" -> <:expr< Camlp4.Sig.Grammar.Structure.NonA >> ] ] + [ [ UIDENT "LEFTA" -> <:expr< Camlp4.Sig.Grammar.LeftA >> + | UIDENT "RIGHTA" -> <:expr< Camlp4.Sig.Grammar.RightA >> + | UIDENT "NONA" -> <:expr< Camlp4.Sig.Grammar.NonA >> ] ] ; rule_list: [ [ "["; "]" -> [] diff --git a/camlp4/Camlp4Parsers/Macro.ml b/camlp4/Camlp4Parsers/Camlp4MacroParser.ml index d94b83e14..3015da99c 100644 --- a/camlp4/Camlp4Parsers/Macro.ml +++ b/camlp4/Camlp4Parsers/Camlp4MacroParser.ml @@ -19,7 +19,7 @@ open Camlp4; (* -*- camlp4r -*- *) *) module Id = struct - value name = "Camlp4Parsers.Macro"; + value name = "Camlp4MacroParser"; value version = "$Id$"; end; @@ -63,10 +63,9 @@ Added statements: The toplevel statement INCLUDE <string> can be used to include a - file containing macro definitions; note that files included in such - a way can not have any non-macro toplevel items. The included files - are looked up in directories passed in via the -I option, falling - back to the current directory. + file containing macro definitions and also any other toplevel items. + The included files are looked up in directories passed in via the -I + option, falling back to the current directory. The expression __FILE__ returns the current compiled file name. The expression __LOCATION__ returns the current location of itself. @@ -75,15 +74,15 @@ Added statements: open Camlp4; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct - open Sig.Camlp4Token; +module Make (Syntax : Sig.Camlp4Syntax) = struct + open Sig; include Syntax; type item_or_def 'a = [ SdStr of 'a | SdDef of string and option (list string * Ast.expr) | SdUnd of string - | SdITE of string and list (item_or_def 'a) and list (item_or_def 'a) + | SdITE of string and 'a and 'a | SdInc of string ]; value rec list_remove x = @@ -224,9 +223,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct in include_dirs.val := include_dirs.val @ [str] else (); - value smlist = Gram.Entry.mk "smlist"; - - value parse_include_file = + value parse_include_file rule = let dir_ok file dir = Sys.file_exists (dir ^ file) in fun file -> let file = @@ -235,61 +232,34 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct in let ch = open_in file in let st = Stream.of_channel ch in - Gram.parse smlist (Loc.mk file) st; - - value rec execute_macro = fun - [ SdStr i -> [i] - | SdDef x eo -> do { define eo x; [] } - | SdUnd x -> do { undef x; [] } - | SdITE i l1 l2 -> - execute_macro_list (if is_defined i then l1 else l2) - | SdInc f -> execute_macro_list (parse_include_file f) ] - - and execute_macro_list = fun - [ [] -> [] - | [hd::tl] -> (* The evaluation order is important here *) - let il1 = execute_macro hd in - let il2 = execute_macro_list tl in - il1 @ il2 ]; + Gram.parse rule (Loc.mk file) st; EXTEND Gram - GLOBAL: expr patt str_item sig_item smlist; + GLOBAL: expr patt str_item sig_item; str_item: FIRST - [ [ x = macro_def -> - match execute_macro x with - [ [] -> <:str_item<>> - | [st] -> st - | [st::stl] -> - List.fold_right - (fun st acc -> <:str_item< $st$; $acc$ >>) stl st ] - ] ] - ; - macro_def: - [ [ "DEFINE"; i = uident; def = opt_macro_value -> SdDef i def - | "UNDEF"; i = uident -> SdUnd i - | "IFDEF"; i = uident; "THEN"; dl = smlist; _ = endif -> - SdITE i dl [] - | "IFDEF"; i = uident; "THEN"; dl1 = smlist; "ELSE"; - dl2 = smlist; _ = endif -> - SdITE i dl1 dl2 - | "IFNDEF"; i = uident; "THEN"; dl = smlist; _ = endif -> - SdITE i [] dl - | "IFNDEF"; i = uident; "THEN"; dl1 = smlist; "ELSE"; - dl2 = smlist; _ = endif -> - SdITE i dl2 dl1 - | "INCLUDE"; fname = STRING -> SdInc fname ] ] + [ [ "DEFINE"; i = uident; def = opt_macro_value -> + do { define def i; <:str_item<>> } + | "UNDEF"; i = uident -> + do { undef i; <:str_item<>> } + | "IFDEF"; i = uident; "THEN"; st = str_items; _ = endif -> + if is_defined i then st else <:str_item<>> + | "IFDEF"; i = uident; "THEN"; st1 = str_items; "ELSE"; st2 = str_items; _ = endif -> + if is_defined i then st1 else st2 + | "IFNDEF"; i = uident; "THEN"; st = str_items; _ = endif -> + if is_defined i then <:str_item<>> else st + | "IFNDEF"; i = uident; "THEN"; st1 = str_items; "ELSE"; st2 = str_items; _ = endif -> + if is_defined i then st2 else st1 + | "INCLUDE"; fname = STRING -> + parse_include_file str_items fname ] ] ; - smlist: - [ [ sml = LIST1 str_item_or_macro -> sml ] ] + sig_item: FIRST + [ [ "INCLUDE"; fname = STRING -> + parse_include_file sig_items fname ] ] ; endif: [ [ "END" -> () | "ENDIF" -> () ] ] ; - str_item_or_macro: - [ [ d = macro_def -> d - | si = str_item -> SdStr si ] ] - ; opt_macro_value: [ [ "("; pl = LIST1 [ x = LIDENT -> x ] SEP ","; ")"; "="; e = expr -> Some (pl, e) | "="; e = expr -> Some ([], e) diff --git a/camlp4/Camlp4Parsers/OCamlOriginalQuotation.ml b/camlp4/Camlp4Parsers/Camlp4OCamlOriginalQuotationExpander.ml index 954ed3ecb..b5b120ba0 100644 --- a/camlp4/Camlp4Parsers/OCamlOriginalQuotation.ml +++ b/camlp4/Camlp4Parsers/Camlp4OCamlOriginalQuotationExpander.ml @@ -20,6 +20,6 @@ open Camlp4; (* -*- camlp4r -*- *) open PreCast; let module Gram = MakeGram Lexer in let module M1 = OCamlInitSyntax.Make Warning Ast Gram Quotation in -let module M2 = OCamlr.Make M1 in -let module M3 = OCaml.Make M2 in -let module M3 = OCamlQuotationBase.Make M3 Syntax.AntiquotSyntax in (); +let module M2 = Camlp4OCamlRevisedParser.Make M1 in +let module M3 = Camlp4OCamlParser.Make M2 in +let module M3 = Camlp4QuotationCommon.Make M3 Syntax.AntiquotSyntax in (); diff --git a/camlp4/Camlp4Parsers/OCaml.ml b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml index d6a9e4164..dcff09d3e 100644 --- a/camlp4/Camlp4Parsers/OCaml.ml +++ b/camlp4/Camlp4Parsers/Camlp4OCamlParser.ml @@ -19,16 +19,16 @@ open Camlp4; (* -*- camlp4r -*- *) *) -module Id : Sig.Id.S = struct - value name = "Camlp4Parsers.OCaml"; +module Id : Sig.Id = struct + value name = "Camlp4OCamlParser"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct - open Sig.Camlp4Token; +module Make (Syntax : Sig.Camlp4Syntax) = struct + open Sig; include Syntax; - Config.constructors_arity.val := False; + Camlp4_config.constructors_arity.val := False; (*FIXME remove this and use OCaml ones *) value bigarray_get _loc arr arg = @@ -261,9 +261,9 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct Gram.Entry.of_parser "test_label_eq" (test 1 where rec test lev strm = match stream_peek_nth lev strm with - [ Some (ANTIQUOT ("id"|"uid"|"lid"|"exp"|"") _ | UIDENT _ | LIDENT _ | KEYWORD ".") -> + [ Some (UIDENT _ | LIDENT _ | KEYWORD ".") -> test (lev + 1) strm - | Some (ANTIQUOT "binding" _ | KEYWORD ("="|"}")) -> () + | Some (KEYWORD "=") -> () | _ -> raise Stream.Failure ]) ; @@ -314,7 +314,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct | <:expr< $_$.$e$ >> -> is_expr_constr_call e | <:expr@_loc< $e$ $_$ >> -> let res = is_expr_constr_call e in - if (not Config.constructors_arity.val) && res then + if (not Camlp4_config.constructors_arity.val) && res then Loc.raise _loc (Stream.Error "currified constructor") else res | _ -> False ]; diff --git a/camlp4/Camlp4Parsers/OCamlParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlParserParser.ml index 96c31b98b..db96dc33f 100644 --- a/camlp4/Camlp4Parsers/OCamlParser.ml +++ b/camlp4/Camlp4Parsers/Camlp4OCamlParserParser.ml @@ -20,16 +20,16 @@ open Camlp4; -module Id : Sig.Id.S = struct - value name = "Camlp4Parsers.OCamlParser"; +module Id : Sig.Id = struct + value name = "Camlp4OCamlParserParser"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct - open Sig.Camlp4Token; +module Make (Syntax : Sig.Camlp4Syntax) = struct + open Sig; include Syntax; - module M = OCamlRevisedParser.Make Syntax; + module M = Camlp4OCamlRevisedParserParser.Make Syntax; open M; Gram.Entry.clear stream_expr; diff --git a/camlp4/Camlp4Parsers/OCamlr.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml index 1306865d7..efdcb5b80 100644 --- a/camlp4/Camlp4Parsers/OCamlr.ml +++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml @@ -19,16 +19,16 @@ open Camlp4; (* -*- camlp4r -*- *) *) module Id = struct - value name = "Camlp4Parsers.OCamlr"; + value name = "Camlp4RevisedParserParser"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct - open Sig.Camlp4Token; +module Make (Syntax : Sig.Camlp4Syntax) = struct + open Sig; include Syntax; - (* Config.constructors_arity.val := True; *) - Config.constructors_arity.val := False; + (* Camlp4_config.constructors_arity.val := True; *) + Camlp4_config.constructors_arity.val := False; value help_sequences () = do { diff --git a/camlp4/Camlp4Parsers/OCamlRevisedParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml index 6730b8336..069ee52c0 100644 --- a/camlp4/Camlp4Parsers/OCamlRevisedParser.ml +++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml @@ -19,13 +19,13 @@ open Camlp4; (* -*- camlp4r -*- *) *) -module Id : Sig.Id.S = struct - value name = "Camlp4Parsers.OCamlRevisedParser"; +module Id : Sig.Id = struct + value name = "Camlp4OCamlRevisedParserParser"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) = struct - open Sig.Camlp4Token; +module Make (Syntax : Sig.Camlp4Syntax) = struct + open Sig; include Syntax; type spat_comp = diff --git a/camlp4/Camlp4Parsers/OCamlRevisedQuotation.ml b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedQuotationExpander.ml index af69b1227..b013be256 100644 --- a/camlp4/Camlp4Parsers/OCamlRevisedQuotation.ml +++ b/camlp4/Camlp4Parsers/Camlp4OCamlRevisedQuotationExpander.ml @@ -20,5 +20,5 @@ open Camlp4; (* -*- camlp4r -*- *) open PreCast; let module Gram = MakeGram Lexer in let module M1 = OCamlInitSyntax.Make Warning Ast Gram Quotation in -let module M2 = OCamlr.Make M1 in -let module M3 = OCamlQuotationBase.Make M2 Syntax.AntiquotSyntax in (); +let module M2 = Camlp4OCamlRevisedParser.Make M1 in +let module M3 = Camlp4QuotationCommon.Make M2 Syntax.AntiquotSyntax in (); diff --git a/camlp4/Camlp4Parsers/OCamlQuotationBase.ml b/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml index 8e4fe8f00..efac02f79 100644 --- a/camlp4/Camlp4Parsers/OCamlQuotationBase.ml +++ b/camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml @@ -18,15 +18,15 @@ open Camlp4; (* -*- camlp4r -*- *) *) module Id = struct - value name = "Camlp4Parsers.OCamlQuotationBase"; + value name = "Camlp4QuotationCommon"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) - (TheAntiquotSyntax : Sig.AntiquotSyntax.S - with module Ast = Sig.Camlp4Ast.ToAst Syntax.Ast) +module Make (Syntax : Sig.Camlp4Syntax) + (TheAntiquotSyntax : Sig.AntiquotSyntax + with module Ast = Sig.Camlp4AstToAst Syntax.Ast) = struct - open Sig.Camlp4Token; + open Sig; include Syntax; (* Be careful an AntiquotSyntax module appears here *) module MetaLocHere = Ast.Meta.MetaLoc; diff --git a/camlp4/Camlp4Parsers/OCamlQuotation.ml b/camlp4/Camlp4Parsers/Camlp4QuotationExpander.ml index ba20ca103..b70e49b89 100644 --- a/camlp4/Camlp4Parsers/OCamlQuotation.ml +++ b/camlp4/Camlp4Parsers/Camlp4QuotationExpander.ml @@ -20,13 +20,13 @@ open Camlp4; (* -*- camlp4r -*- *) module Id = struct - value name = "Camlp4Parsers.OCamlQuotation"; + value name = "Camlp4QuotationExpander"; value version = "$Id$"; end; -module Make (Syntax : Sig.Camlp4Syntax.S) +module Make (Syntax : Sig.Camlp4Syntax) = struct - module M = OCamlQuotationBase.Make Syntax Syntax.AntiquotSyntax; + module M = Camlp4QuotationCommon.Make Syntax Syntax.AntiquotSyntax; include M; end; diff --git a/camlp4/Camlp4Printers/DumpCamlp4Ast.ml b/camlp4/Camlp4Printers/Camlp4AstDumper.ml index f89fed40f..f89fed40f 100644 --- a/camlp4/Camlp4Printers/DumpCamlp4Ast.ml +++ b/camlp4/Camlp4Printers/Camlp4AstDumper.ml diff --git a/camlp4/Camlp4Printers/Auto.ml b/camlp4/Camlp4Printers/Camlp4AutoPrinter.ml index eb6b9a24d..eb6b9a24d 100644 --- a/camlp4/Camlp4Printers/Auto.ml +++ b/camlp4/Camlp4Printers/Camlp4AutoPrinter.ml diff --git a/camlp4/Camlp4Printers/Null.ml b/camlp4/Camlp4Printers/Camlp4NullDumper.ml index 0e02b66df..0e02b66df 100644 --- a/camlp4/Camlp4Printers/Null.ml +++ b/camlp4/Camlp4Printers/Camlp4NullDumper.ml diff --git a/camlp4/Camlp4Printers/DumpOCamlAst.ml b/camlp4/Camlp4Printers/Camlp4OCamlAstDumper.ml index 174e5ad13..174e5ad13 100644 --- a/camlp4/Camlp4Printers/DumpOCamlAst.ml +++ b/camlp4/Camlp4Printers/Camlp4OCamlAstDumper.ml diff --git a/camlp4/Camlp4Printers/OCaml.ml b/camlp4/Camlp4Printers/Camlp4OCamlPrinter.ml index 487b8627b..487b8627b 100644 --- a/camlp4/Camlp4Printers/OCaml.ml +++ b/camlp4/Camlp4Printers/Camlp4OCamlPrinter.ml diff --git a/camlp4/Camlp4Printers/OCamlr.ml b/camlp4/Camlp4Printers/Camlp4OCamlRevisedPrinter.ml index bd5af1f50..bd5af1f50 100644 --- a/camlp4/Camlp4Printers/OCamlr.ml +++ b/camlp4/Camlp4Printers/Camlp4OCamlRevisedPrinter.ml diff --git a/camlp4/Camlp4Profiler.ml b/camlp4/Camlp4Profiler.ml deleted file mode 100644 index 227b09a91..000000000 --- a/camlp4/Camlp4Profiler.ml +++ /dev/null @@ -1,14 +0,0 @@ -(* camlp4r *) - -value count = - let h = Hashtbl.create 1007 in - let () = at_exit (fun () -> - let assoc = Hashtbl.fold (fun k v a -> [ (k, v.val) :: a ]) h [] in - let out = open_out "camlp4_profiler.out" in - let () = Marshal.to_channel out assoc [] in - close_out out) in - fun s -> - try incr (Hashtbl.find h s) - with [ Not_found -> Hashtbl.add h s (ref 1) ]; - -value load = Marshal.from_channel; diff --git a/camlp4/Camlp4Top/Camlp4Top.ml b/camlp4/Camlp4Top/Top.ml index 817227138..9a5141362 100644 --- a/camlp4/Camlp4Top/Camlp4Top.ml +++ b/camlp4/Camlp4Top/Top.ml @@ -25,7 +25,7 @@ open Lexing; open Camlp4; open PreCast; open Syntax; -open Camlp4.Sig.Camlp4Token; +open Camlp4.Sig; module Ast2pt = Camlp4.Struct.Camlp4Ast2OCamlAst.Make Ast; module Lexer = Camlp4.Struct.Lexer.Make Token; @@ -39,7 +39,7 @@ value wrap parse_fun = match token_stream_ref.val with [ None -> let () = if Sys.interactive.val then - Format.printf "\tCamlp4 Parsing version %s\n@." Config.version + Format.printf "\tCamlp4 Parsing version %s\n@." Camlp4_config.version else () in let not_filtered_token_stream = Lexer.from_lexbuf lb in let token_stream = Gram.filter (not_filtered not_filtered_token_stream) in diff --git a/camlp4/Camlp4_config.ml b/camlp4/Camlp4_config.ml new file mode 100644 index 000000000..362848493 --- /dev/null +++ b/camlp4/Camlp4_config.ml @@ -0,0 +1,39 @@ +(* camlp4r *) +(****************************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the Objective *) +(* Caml source tree. *) +(* *) +(****************************************************************************) + +(* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + +let ocaml_standard_library = Config.standard_library;; + +let camlp4_standard_library = + try Sys.getenv "CAMLP4LIB" + with Not_found -> + Filename.concat ocaml_standard_library "camlp4";; + +let version = Sys.ocaml_version;; +let program_name = ref "camlp4";; +let constructors_arity = ref true;; +let unsafe = ref false;; +let verbose = ref false;; +let quotations = ref true;; +let inter_phrases = ref None;; +let camlp4_ast_impl_magic_number = "Camlp42006M001";; +let camlp4_ast_intf_magic_number = "Camlp42006N001";; +let ocaml_ast_intf_magic_number = Config.ast_intf_magic_number;; +let ocaml_ast_impl_magic_number = Config.ast_impl_magic_number;; +let current_input_file = ref "";; diff --git a/camlp4/Camlp4/Config.mli b/camlp4/Camlp4_config.mli index eb18d6e84..c2647b890 100644 --- a/camlp4/Camlp4/Config.mli +++ b/camlp4/Camlp4_config.mli @@ -17,17 +17,17 @@ * - Nicolas Pouillard: refactoring *) -value version : string; -value ocaml_standard_library : string; -value camlp4_standard_library : string; -value ocaml_ast_impl_magic_number : string; -value ocaml_ast_intf_magic_number : string; -value camlp4_ast_impl_magic_number : string; -value camlp4_ast_intf_magic_number : string; -value program_name : ref string; -value unsafe : ref bool; -value verbose : ref bool; -value quotations : ref bool; -value constructors_arity : ref bool; -value inter_phrases : ref (option string); -value current_input_file : ref string; +val version : string;; +val ocaml_standard_library : string;; +val camlp4_standard_library : string;; +val ocaml_ast_impl_magic_number : string;; +val ocaml_ast_intf_magic_number : string;; +val camlp4_ast_impl_magic_number : string;; +val camlp4_ast_intf_magic_number : string;; +val program_name : string ref;; +val unsafe : bool ref;; +val verbose : bool ref;; +val quotations : bool ref;; +val constructors_arity : bool ref;; +val inter_phrases : (string option) ref;; +val current_input_file : string ref;; diff --git a/camlp4/Makefile.clean b/camlp4/Makefile.clean deleted file mode 100644 index f59f01650..000000000 --- a/camlp4/Makefile.clean +++ /dev/null @@ -1,1054 +0,0 @@ -CLEANFILES = \ - Camlp4Top.ml \ - Camlp4Top.o \ - Camlp4Top.cmo \ - Camlp4Top.cmi \ - Camlp4Top.cmx \ - Camlp4Top/Camlp4Top.o \ - Camlp4Top/Camlp4Top.annot \ - Camlp4Top/Camlp4Top.cmo \ - Camlp4Top/Camlp4Top.cmi \ - Camlp4Top/Camlp4Top.cmx \ - Camlp4Top/Rprint.o \ - Camlp4Top/Rprint.annot \ - Camlp4Top/Rprint.cmo \ - Camlp4Top/Rprint.cmi \ - Camlp4Top/Rprint.cmx \ - Camlp4Filters.ml \ - Camlp4Filters.o \ - Camlp4Filters.cmo \ - Camlp4Filters.cmi \ - Camlp4Filters.cmx \ - Camlp4Filters/Profiler.o \ - Camlp4Filters/Profiler.annot \ - Camlp4Filters/Profiler.cmo \ - Camlp4Filters/Profiler.cmi \ - Camlp4Filters/Profiler.cmx \ - Camlp4Filters/RemoveTrashModule.o \ - Camlp4Filters/RemoveTrashModule.annot \ - Camlp4Filters/RemoveTrashModule.cmo \ - Camlp4Filters/RemoveTrashModule.cmi \ - Camlp4Filters/RemoveTrashModule.cmx \ - Camlp4Filters/MetaGenerator.o \ - Camlp4Filters/MetaGenerator.annot \ - Camlp4Filters/MetaGenerator.cmo \ - Camlp4Filters/MetaGenerator.cmi \ - Camlp4Filters/MetaGenerator.cmx \ - Camlp4Filters/GenerateFold.o \ - Camlp4Filters/GenerateFold.annot \ - Camlp4Filters/GenerateFold.cmo \ - Camlp4Filters/GenerateFold.cmi \ - Camlp4Filters/GenerateFold.cmx \ - Camlp4Filters/GenerateMap.o \ - Camlp4Filters/GenerateMap.annot \ - Camlp4Filters/GenerateMap.cmo \ - Camlp4Filters/GenerateMap.cmi \ - Camlp4Filters/GenerateMap.cmx \ - Camlp4Filters/LiftCamlp4Ast.o \ - Camlp4Filters/LiftCamlp4Ast.annot \ - Camlp4Filters/LiftCamlp4Ast.cmo \ - Camlp4Filters/LiftCamlp4Ast.cmi \ - Camlp4Filters/LiftCamlp4Ast.cmx \ - Camlp4Filters/StripLocations.o \ - Camlp4Filters/StripLocations.annot \ - Camlp4Filters/StripLocations.cmo \ - Camlp4Filters/StripLocations.cmi \ - Camlp4Filters/StripLocations.cmx \ - Camlp4Filters/Tracer.o \ - Camlp4Filters/Tracer.annot \ - Camlp4Filters/Tracer.cmo \ - Camlp4Filters/Tracer.cmi \ - Camlp4Filters/Tracer.cmx \ - Camlp4Filters/ExceptionTracer.o \ - Camlp4Filters/ExceptionTracer.annot \ - Camlp4Filters/ExceptionTracer.cmo \ - Camlp4Filters/ExceptionTracer.cmi \ - Camlp4Filters/ExceptionTracer.cmx \ - Camlp4Printers.ml \ - Camlp4Printers.o \ - Camlp4Printers.cmo \ - Camlp4Printers.cmi \ - Camlp4Printers.cmx \ - Camlp4Printers/Auto.o \ - Camlp4Printers/Auto.annot \ - Camlp4Printers/Auto.cmo \ - Camlp4Printers/Auto.cmi \ - Camlp4Printers/Auto.cmx \ - Camlp4Printers/Null.o \ - Camlp4Printers/Null.annot \ - Camlp4Printers/Null.cmo \ - Camlp4Printers/Null.cmi \ - Camlp4Printers/Null.cmx \ - Camlp4Printers/OCamlr.o \ - Camlp4Printers/OCamlr.annot \ - Camlp4Printers/OCamlr.cmo \ - Camlp4Printers/OCamlr.cmi \ - Camlp4Printers/OCamlr.cmx \ - Camlp4Printers/OCaml.o \ - Camlp4Printers/OCaml.annot \ - Camlp4Printers/OCaml.cmo \ - Camlp4Printers/OCaml.cmi \ - Camlp4Printers/OCaml.cmx \ - Camlp4Printers/DumpCamlp4Ast.o \ - Camlp4Printers/DumpCamlp4Ast.annot \ - Camlp4Printers/DumpCamlp4Ast.cmo \ - Camlp4Printers/DumpCamlp4Ast.cmi \ - Camlp4Printers/DumpCamlp4Ast.cmx \ - Camlp4Printers/DumpOCamlAst.o \ - Camlp4Printers/DumpOCamlAst.annot \ - Camlp4Printers/DumpOCamlAst.cmo \ - Camlp4Printers/DumpOCamlAst.cmi \ - Camlp4Printers/DumpOCamlAst.cmx \ - Camlp4Parsers.ml \ - Camlp4Parsers.o \ - Camlp4Parsers.cmo \ - Camlp4Parsers.cmi \ - Camlp4Parsers.cmx \ - Camlp4Parsers/LoadCamlp4Ast.o \ - Camlp4Parsers/LoadCamlp4Ast.annot \ - Camlp4Parsers/LoadCamlp4Ast.cmo \ - Camlp4Parsers/LoadCamlp4Ast.cmi \ - Camlp4Parsers/LoadCamlp4Ast.cmx \ - Camlp4Parsers/Debug.o \ - Camlp4Parsers/Debug.annot \ - Camlp4Parsers/Debug.cmo \ - Camlp4Parsers/Debug.cmi \ - Camlp4Parsers/Debug.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCamlOriginalQuotation.o \ - Camlp4Parsers/OCamlOriginalQuotation.annot \ - Camlp4Parsers/OCamlOriginalQuotation.cmo \ - Camlp4Parsers/OCamlOriginalQuotation.cmi \ - Camlp4Parsers/OCamlOriginalQuotation.cmx \ - Camlp4Parsers/OCamlRevisedQuotation.o \ - Camlp4Parsers/OCamlRevisedQuotation.annot \ - Camlp4Parsers/OCamlRevisedQuotation.cmo \ - Camlp4Parsers/OCamlRevisedQuotation.cmi \ - Camlp4Parsers/OCamlRevisedQuotation.cmx \ - Camlp4Parsers/OCamlQuotation.o \ - Camlp4Parsers/OCamlQuotation.annot \ - Camlp4Parsers/OCamlQuotation.cmo \ - Camlp4Parsers/OCamlQuotation.cmi \ - Camlp4Parsers/OCamlQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4prof.run \ - camlp4prof.opt \ - camlp4prof.o \ - camlp4prof.annot \ - camlp4prof.cmo \ - camlp4prof.cmi \ - camlp4prof.cmx \ - Camlp4Profiler.o \ - Camlp4Profiler.annot \ - Camlp4Profiler.cmo \ - Camlp4Profiler.cmi \ - Camlp4Profiler.cmx \ - mkcamlp4.run \ - mkcamlp4.opt \ - mkcamlp4.o \ - mkcamlp4.annot \ - mkcamlp4.cmo \ - mkcamlp4.cmi \ - mkcamlp4.cmx \ - camlp4orf.a \ - Camlp4Top/Camlp4Top.o \ - Camlp4Top/Camlp4Top.annot \ - Camlp4Top/Camlp4Top.cmo \ - Camlp4Top/Camlp4Top.cmi \ - Camlp4Top/Camlp4Top.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlRevisedQuotation.o \ - Camlp4Parsers/OCamlRevisedQuotation.annot \ - Camlp4Parsers/OCamlRevisedQuotation.cmo \ - Camlp4Parsers/OCamlRevisedQuotation.cmi \ - Camlp4Parsers/OCamlRevisedQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4orf.run \ - camlp4orf.opt \ - Camlp4Bin.o \ - Camlp4Bin.annot \ - Camlp4Bin.cmo \ - Camlp4Bin.cmi \ - Camlp4Bin.cmx \ - Camlp4Printers/Auto.o \ - Camlp4Printers/Auto.annot \ - Camlp4Printers/Auto.cmo \ - Camlp4Printers/Auto.cmi \ - Camlp4Printers/Auto.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlRevisedQuotation.o \ - Camlp4Parsers/OCamlRevisedQuotation.annot \ - Camlp4Parsers/OCamlRevisedQuotation.cmo \ - Camlp4Parsers/OCamlRevisedQuotation.cmi \ - Camlp4Parsers/OCamlRevisedQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4oof.a \ - Camlp4Top/Camlp4Top.o \ - Camlp4Top/Camlp4Top.annot \ - Camlp4Top/Camlp4Top.cmo \ - Camlp4Top/Camlp4Top.cmi \ - Camlp4Top/Camlp4Top.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlOriginalQuotation.o \ - Camlp4Parsers/OCamlOriginalQuotation.annot \ - Camlp4Parsers/OCamlOriginalQuotation.cmo \ - Camlp4Parsers/OCamlOriginalQuotation.cmi \ - Camlp4Parsers/OCamlOriginalQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4oof.run \ - camlp4oof.opt \ - Camlp4Bin.o \ - Camlp4Bin.annot \ - Camlp4Bin.cmo \ - Camlp4Bin.cmi \ - Camlp4Bin.cmx \ - Camlp4Printers/Auto.o \ - Camlp4Printers/Auto.annot \ - Camlp4Printers/Auto.cmo \ - Camlp4Printers/Auto.cmi \ - Camlp4Printers/Auto.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlOriginalQuotation.o \ - Camlp4Parsers/OCamlOriginalQuotation.annot \ - Camlp4Parsers/OCamlOriginalQuotation.cmo \ - Camlp4Parsers/OCamlOriginalQuotation.cmi \ - Camlp4Parsers/OCamlOriginalQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4of.a \ - Camlp4Top/Camlp4Top.o \ - Camlp4Top/Camlp4Top.annot \ - Camlp4Top/Camlp4Top.cmo \ - Camlp4Top/Camlp4Top.cmi \ - Camlp4Top/Camlp4Top.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlQuotation.o \ - Camlp4Parsers/OCamlQuotation.annot \ - Camlp4Parsers/OCamlQuotation.cmo \ - Camlp4Parsers/OCamlQuotation.cmi \ - Camlp4Parsers/OCamlQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4of.run \ - camlp4of.opt \ - Camlp4Bin.o \ - Camlp4Bin.annot \ - Camlp4Bin.cmo \ - Camlp4Bin.cmi \ - Camlp4Bin.cmx \ - Camlp4Printers/Auto.o \ - Camlp4Printers/Auto.annot \ - Camlp4Printers/Auto.cmo \ - Camlp4Printers/Auto.cmi \ - Camlp4Printers/Auto.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlQuotation.o \ - Camlp4Parsers/OCamlQuotation.annot \ - Camlp4Parsers/OCamlQuotation.cmo \ - Camlp4Parsers/OCamlQuotation.cmi \ - Camlp4Parsers/OCamlQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4o.a \ - Camlp4Top/Camlp4Top.o \ - Camlp4Top/Camlp4Top.annot \ - Camlp4Top/Camlp4Top.cmo \ - Camlp4Top/Camlp4Top.cmi \ - Camlp4Top/Camlp4Top.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4o.run \ - camlp4o.opt \ - Camlp4Bin.o \ - Camlp4Bin.annot \ - Camlp4Bin.cmo \ - Camlp4Bin.cmi \ - Camlp4Bin.cmx \ - Camlp4Printers/Auto.o \ - Camlp4Printers/Auto.annot \ - Camlp4Printers/Auto.cmo \ - Camlp4Printers/Auto.cmi \ - Camlp4Printers/Auto.cmx \ - Camlp4Parsers/OCamlParser.o \ - Camlp4Parsers/OCamlParser.annot \ - Camlp4Parsers/OCamlParser.cmo \ - Camlp4Parsers/OCamlParser.cmi \ - Camlp4Parsers/OCamlParser.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCaml.o \ - Camlp4Parsers/OCaml.annot \ - Camlp4Parsers/OCaml.cmo \ - Camlp4Parsers/OCaml.cmi \ - Camlp4Parsers/OCaml.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4rf.a \ - Camlp4Top/Camlp4Top.o \ - Camlp4Top/Camlp4Top.annot \ - Camlp4Top/Camlp4Top.cmo \ - Camlp4Top/Camlp4Top.cmi \ - Camlp4Top/Camlp4Top.cmx \ - Camlp4Top/Rprint.o \ - Camlp4Top/Rprint.annot \ - Camlp4Top/Rprint.cmo \ - Camlp4Top/Rprint.cmi \ - Camlp4Top/Rprint.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCamlQuotation.o \ - Camlp4Parsers/OCamlQuotation.annot \ - Camlp4Parsers/OCamlQuotation.cmo \ - Camlp4Parsers/OCamlQuotation.cmi \ - Camlp4Parsers/OCamlQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4rf.run \ - camlp4rf.opt \ - Camlp4Bin.o \ - Camlp4Bin.annot \ - Camlp4Bin.cmo \ - Camlp4Bin.cmi \ - Camlp4Bin.cmx \ - Camlp4Printers/Auto.o \ - Camlp4Printers/Auto.annot \ - Camlp4Printers/Auto.cmo \ - Camlp4Printers/Auto.cmi \ - Camlp4Printers/Auto.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCamlQuotation.o \ - Camlp4Parsers/OCamlQuotation.annot \ - Camlp4Parsers/OCamlQuotation.cmo \ - Camlp4Parsers/OCamlQuotation.cmi \ - Camlp4Parsers/OCamlQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4r.a \ - Camlp4Top/Camlp4Top.o \ - Camlp4Top/Camlp4Top.annot \ - Camlp4Top/Camlp4Top.cmo \ - Camlp4Top/Camlp4Top.cmi \ - Camlp4Top/Camlp4Top.cmx \ - Camlp4Top/Rprint.o \ - Camlp4Top/Rprint.annot \ - Camlp4Top/Rprint.cmo \ - Camlp4Top/Rprint.cmi \ - Camlp4Top/Rprint.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4r.run \ - camlp4r.opt \ - Camlp4Bin.o \ - Camlp4Bin.annot \ - Camlp4Bin.cmo \ - Camlp4Bin.cmi \ - Camlp4Bin.cmx \ - Camlp4Printers/Auto.o \ - Camlp4Printers/Auto.annot \ - Camlp4Printers/Auto.cmo \ - Camlp4Printers/Auto.cmi \ - Camlp4Printers/Auto.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4boot.a \ - Camlp4Top/Camlp4Top.o \ - Camlp4Top/Camlp4Top.annot \ - Camlp4Top/Camlp4Top.cmo \ - Camlp4Top/Camlp4Top.cmi \ - Camlp4Top/Camlp4Top.cmx \ - Camlp4Top/Rprint.o \ - Camlp4Top/Rprint.annot \ - Camlp4Top/Rprint.cmo \ - Camlp4Top/Rprint.cmi \ - Camlp4Top/Rprint.cmx \ - Camlp4Parsers/Debug.o \ - Camlp4Parsers/Debug.annot \ - Camlp4Parsers/Debug.cmo \ - Camlp4Parsers/Debug.cmi \ - Camlp4Parsers/Debug.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCamlQuotation.o \ - Camlp4Parsers/OCamlQuotation.annot \ - Camlp4Parsers/OCamlQuotation.cmo \ - Camlp4Parsers/OCamlQuotation.cmi \ - Camlp4Parsers/OCamlQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4boot.run \ - camlp4boot.opt \ - Camlp4Bin.o \ - Camlp4Bin.annot \ - Camlp4Bin.cmo \ - Camlp4Bin.cmi \ - Camlp4Bin.cmx \ - Camlp4Printers/DumpOCamlAst.o \ - Camlp4Printers/DumpOCamlAst.annot \ - Camlp4Printers/DumpOCamlAst.cmo \ - Camlp4Printers/DumpOCamlAst.cmi \ - Camlp4Printers/DumpOCamlAst.cmx \ - Camlp4Parsers/Debug.o \ - Camlp4Parsers/Debug.annot \ - Camlp4Parsers/Debug.cmo \ - Camlp4Parsers/Debug.cmi \ - Camlp4Parsers/Debug.cmx \ - Camlp4Parsers/Macro.o \ - Camlp4Parsers/Macro.annot \ - Camlp4Parsers/Macro.cmo \ - Camlp4Parsers/Macro.cmi \ - Camlp4Parsers/Macro.cmx \ - Camlp4Parsers/Grammar.o \ - Camlp4Parsers/Grammar.annot \ - Camlp4Parsers/Grammar.cmo \ - Camlp4Parsers/Grammar.cmi \ - Camlp4Parsers/Grammar.cmx \ - Camlp4Parsers/OCamlRevisedParser.o \ - Camlp4Parsers/OCamlRevisedParser.annot \ - Camlp4Parsers/OCamlRevisedParser.cmo \ - Camlp4Parsers/OCamlRevisedParser.cmi \ - Camlp4Parsers/OCamlRevisedParser.cmx \ - Camlp4Parsers/OCamlQuotation.o \ - Camlp4Parsers/OCamlQuotation.annot \ - Camlp4Parsers/OCamlQuotation.cmo \ - Camlp4Parsers/OCamlQuotation.cmi \ - Camlp4Parsers/OCamlQuotation.cmx \ - Camlp4Parsers/OCamlQuotationBase.o \ - Camlp4Parsers/OCamlQuotationBase.annot \ - Camlp4Parsers/OCamlQuotationBase.cmo \ - Camlp4Parsers/OCamlQuotationBase.cmi \ - Camlp4Parsers/OCamlQuotationBase.cmx \ - Camlp4Parsers/OCamlr.o \ - Camlp4Parsers/OCamlr.annot \ - Camlp4Parsers/OCamlr.cmo \ - Camlp4Parsers/OCamlr.cmi \ - Camlp4Parsers/OCamlr.cmx \ - camlp4.run \ - camlp4.opt \ - Camlp4Bin.o \ - Camlp4Bin.annot \ - Camlp4Bin.cmo \ - Camlp4Bin.cmi \ - Camlp4Bin.cmx \ - Camlp4.a \ - Camlp4.ml \ - Camlp4.o \ - Camlp4.cmo \ - Camlp4.cmi \ - Camlp4.cmx \ - Camlp4/Register.o \ - Camlp4/Register.annot \ - Camlp4/Register.cmo \ - Camlp4/Register.cmi \ - Camlp4/Register.cmx \ - Camlp4/PreCast.o \ - Camlp4/PreCast.annot \ - Camlp4/PreCast.cmo \ - Camlp4/PreCast.cmi \ - Camlp4/PreCast.cmx \ - Camlp4/Printers.ml \ - Camlp4/Printers.o \ - Camlp4/Printers.cmo \ - Camlp4/Printers.cmi \ - Camlp4/Printers.cmx \ - Camlp4/Printers/OCamlr.o \ - Camlp4/Printers/OCamlr.annot \ - Camlp4/Printers/OCamlr.cmo \ - Camlp4/Printers/OCamlr.cmi \ - Camlp4/Printers/OCamlr.cmx \ - Camlp4/Printers/OCaml.o \ - Camlp4/Printers/OCaml.annot \ - Camlp4/Printers/OCaml.cmo \ - Camlp4/Printers/OCaml.cmi \ - Camlp4/Printers/OCaml.cmx \ - Camlp4/Printers/DumpCamlp4Ast.o \ - Camlp4/Printers/DumpCamlp4Ast.annot \ - Camlp4/Printers/DumpCamlp4Ast.cmo \ - Camlp4/Printers/DumpCamlp4Ast.cmi \ - Camlp4/Printers/DumpCamlp4Ast.cmx \ - Camlp4/Printers/DumpOCamlAst.o \ - Camlp4/Printers/DumpOCamlAst.annot \ - Camlp4/Printers/DumpOCamlAst.cmo \ - Camlp4/Printers/DumpOCamlAst.cmi \ - Camlp4/Printers/DumpOCamlAst.cmx \ - Camlp4/Printers/Null.o \ - Camlp4/Printers/Null.annot \ - Camlp4/Printers/Null.cmo \ - Camlp4/Printers/Null.cmi \ - Camlp4/Printers/Null.cmx \ - Camlp4/OCamlInitSyntax.o \ - Camlp4/OCamlInitSyntax.annot \ - Camlp4/OCamlInitSyntax.cmo \ - Camlp4/OCamlInitSyntax.cmi \ - Camlp4/OCamlInitSyntax.cmx \ - Camlp4/Struct.ml \ - Camlp4/Struct.o \ - Camlp4/Struct.cmo \ - Camlp4/Struct.cmi \ - Camlp4/Struct.cmx \ - Camlp4/Struct/CommentFilter.o \ - Camlp4/Struct/CommentFilter.annot \ - Camlp4/Struct/CommentFilter.cmo \ - Camlp4/Struct/CommentFilter.cmi \ - Camlp4/Struct/CommentFilter.cmx \ - Camlp4/Struct/CleanAst.o \ - Camlp4/Struct/CleanAst.annot \ - Camlp4/Struct/CleanAst.cmo \ - Camlp4/Struct/CleanAst.cmi \ - Camlp4/Struct/CleanAst.cmx \ - Camlp4/Struct/Camlp4Ast2OCamlAst.o \ - Camlp4/Struct/Camlp4Ast2OCamlAst.annot \ - Camlp4/Struct/Camlp4Ast2OCamlAst.cmo \ - Camlp4/Struct/Camlp4Ast2OCamlAst.cmi \ - Camlp4/Struct/Camlp4Ast2OCamlAst.cmx \ - Camlp4/Struct/AstFilters.o \ - Camlp4/Struct/AstFilters.annot \ - Camlp4/Struct/AstFilters.cmo \ - Camlp4/Struct/AstFilters.cmi \ - Camlp4/Struct/AstFilters.cmx \ - Camlp4/Struct/FreeVars.o \ - Camlp4/Struct/FreeVars.annot \ - Camlp4/Struct/FreeVars.cmo \ - Camlp4/Struct/FreeVars.cmi \ - Camlp4/Struct/FreeVars.cmx \ - Camlp4/Struct/Camlp4Ast.o \ - Camlp4/Struct/Camlp4Ast.annot \ - Camlp4/Struct/Camlp4Ast.cmo \ - Camlp4/Struct/Camlp4Ast.cmi \ - Camlp4/Struct/Camlp4Ast.cmx \ - Camlp4/Struct/DynLoader.o \ - Camlp4/Struct/DynLoader.annot \ - Camlp4/Struct/DynLoader.cmo \ - Camlp4/Struct/DynLoader.cmi \ - Camlp4/Struct/DynLoader.cmx \ - Camlp4/Struct/Quotation.o \ - Camlp4/Struct/Quotation.annot \ - Camlp4/Struct/Quotation.cmo \ - Camlp4/Struct/Quotation.cmi \ - Camlp4/Struct/Quotation.cmx \ - Camlp4/Struct/Grammar.ml \ - Camlp4/Struct/Grammar.o \ - Camlp4/Struct/Grammar.cmo \ - Camlp4/Struct/Grammar.cmi \ - Camlp4/Struct/Grammar.cmx \ - Camlp4/Struct/Grammar/Static.o \ - Camlp4/Struct/Grammar/Static.annot \ - Camlp4/Struct/Grammar/Static.cmo \ - Camlp4/Struct/Grammar/Static.cmi \ - Camlp4/Struct/Grammar/Static.cmx \ - Camlp4/Struct/Grammar/Dynamic.o \ - Camlp4/Struct/Grammar/Dynamic.annot \ - Camlp4/Struct/Grammar/Dynamic.cmo \ - Camlp4/Struct/Grammar/Dynamic.cmi \ - Camlp4/Struct/Grammar/Dynamic.cmx \ - Camlp4/Struct/Grammar/Find.o \ - Camlp4/Struct/Grammar/Find.annot \ - Camlp4/Struct/Grammar/Find.cmo \ - Camlp4/Struct/Grammar/Find.cmi \ - Camlp4/Struct/Grammar/Find.cmx \ - Camlp4/Struct/Grammar/Entry.o \ - Camlp4/Struct/Grammar/Entry.annot \ - Camlp4/Struct/Grammar/Entry.cmo \ - Camlp4/Struct/Grammar/Entry.cmi \ - Camlp4/Struct/Grammar/Entry.cmx \ - Camlp4/Struct/Grammar/Delete.o \ - Camlp4/Struct/Grammar/Delete.annot \ - Camlp4/Struct/Grammar/Delete.cmo \ - Camlp4/Struct/Grammar/Delete.cmi \ - Camlp4/Struct/Grammar/Delete.cmx \ - Camlp4/Struct/Grammar/Insert.o \ - Camlp4/Struct/Grammar/Insert.annot \ - Camlp4/Struct/Grammar/Insert.cmo \ - Camlp4/Struct/Grammar/Insert.cmi \ - Camlp4/Struct/Grammar/Insert.cmx \ - Camlp4/Struct/Grammar/Fold.o \ - Camlp4/Struct/Grammar/Fold.annot \ - Camlp4/Struct/Grammar/Fold.cmo \ - Camlp4/Struct/Grammar/Fold.cmi \ - Camlp4/Struct/Grammar/Fold.cmx \ - Camlp4/Struct/Grammar/Parser.o \ - Camlp4/Struct/Grammar/Parser.annot \ - Camlp4/Struct/Grammar/Parser.cmo \ - Camlp4/Struct/Grammar/Parser.cmi \ - Camlp4/Struct/Grammar/Parser.cmx \ - Camlp4/Struct/Grammar/Failed.o \ - Camlp4/Struct/Grammar/Failed.annot \ - Camlp4/Struct/Grammar/Failed.cmo \ - Camlp4/Struct/Grammar/Failed.cmi \ - Camlp4/Struct/Grammar/Failed.cmx \ - Camlp4/Struct/Grammar/Print.o \ - Camlp4/Struct/Grammar/Print.annot \ - Camlp4/Struct/Grammar/Print.cmo \ - Camlp4/Struct/Grammar/Print.cmi \ - Camlp4/Struct/Grammar/Print.cmx \ - Camlp4/Struct/Grammar/Tools.o \ - Camlp4/Struct/Grammar/Tools.annot \ - Camlp4/Struct/Grammar/Tools.cmo \ - Camlp4/Struct/Grammar/Tools.cmi \ - Camlp4/Struct/Grammar/Tools.cmx \ - Camlp4/Struct/Grammar/Search.o \ - Camlp4/Struct/Grammar/Search.annot \ - Camlp4/Struct/Grammar/Search.cmo \ - Camlp4/Struct/Grammar/Search.cmi \ - Camlp4/Struct/Grammar/Search.cmx \ - Camlp4/Struct/Grammar/Structure.o \ - Camlp4/Struct/Grammar/Structure.annot \ - Camlp4/Struct/Grammar/Structure.cmo \ - Camlp4/Struct/Grammar/Structure.cmi \ - Camlp4/Struct/Grammar/Structure.cmx \ - Camlp4/Struct/Grammar/Context.o \ - Camlp4/Struct/Grammar/Context.annot \ - Camlp4/Struct/Grammar/Context.cmo \ - Camlp4/Struct/Grammar/Context.cmi \ - Camlp4/Struct/Grammar/Context.cmx \ - Camlp4/Struct/Lexer.ml \ - Camlp4/Struct/Lexer.o \ - Camlp4/Struct/Lexer.annot \ - Camlp4/Struct/Lexer.cmo \ - Camlp4/Struct/Lexer.cmi \ - Camlp4/Struct/Lexer.cmx \ - Camlp4/Struct/Token.o \ - Camlp4/Struct/Token.annot \ - Camlp4/Struct/Token.cmo \ - Camlp4/Struct/Token.cmi \ - Camlp4/Struct/Token.cmx \ - Camlp4/Struct/EmptyPrinter.o \ - Camlp4/Struct/EmptyPrinter.annot \ - Camlp4/Struct/EmptyPrinter.cmo \ - Camlp4/Struct/EmptyPrinter.cmi \ - Camlp4/Struct/EmptyPrinter.cmx \ - Camlp4/Struct/EmptyError.o \ - Camlp4/Struct/EmptyError.annot \ - Camlp4/Struct/EmptyError.cmo \ - Camlp4/Struct/EmptyError.cmi \ - Camlp4/Struct/EmptyError.cmx \ - Camlp4/Struct/Warning.o \ - Camlp4/Struct/Warning.annot \ - Camlp4/Struct/Warning.cmo \ - Camlp4/Struct/Warning.cmi \ - Camlp4/Struct/Warning.cmx \ - Camlp4/Struct/Loc.o \ - Camlp4/Struct/Loc.annot \ - Camlp4/Struct/Loc.cmo \ - Camlp4/Struct/Loc.cmi \ - Camlp4/Struct/Loc.cmx \ - Camlp4/ErrorHandler.o \ - Camlp4/ErrorHandler.annot \ - Camlp4/ErrorHandler.cmo \ - Camlp4/ErrorHandler.cmi \ - Camlp4/ErrorHandler.cmx \ - Camlp4/Sig.ml \ - Camlp4/Sig.o \ - Camlp4/Sig.cmo \ - Camlp4/Sig.cmi \ - Camlp4/Sig.cmx \ - Camlp4/Sig/SyntaxExtension.annot \ - Camlp4/Sig/SyntaxExtension.cmi \ - Camlp4/Sig/AstFilters.annot \ - Camlp4/Sig/AstFilters.cmi \ - Camlp4/Sig/Camlp4Syntax.annot \ - Camlp4/Sig/Camlp4Syntax.cmi \ - Camlp4/Sig/Syntax.annot \ - Camlp4/Sig/Syntax.cmi \ - Camlp4/Sig/Printer.annot \ - Camlp4/Sig/Printer.cmi \ - Camlp4/Sig/Parser.annot \ - Camlp4/Sig/Parser.cmi \ - Camlp4/Sig/AntiquotSyntax.annot \ - Camlp4/Sig/AntiquotSyntax.cmi \ - Camlp4/Sig/DynLoader.annot \ - Camlp4/Sig/DynLoader.cmi \ - Camlp4/Sig/Camlp4Token.annot \ - Camlp4/Sig/Camlp4Token.cmi \ - Camlp4/Sig/Quotation.annot \ - Camlp4/Sig/Quotation.cmi \ - Camlp4/Sig/Camlp4Ast.o \ - Camlp4/Sig/Camlp4Ast.annot \ - Camlp4/Sig/Camlp4Ast.cmo \ - Camlp4/Sig/Camlp4Ast.cmi \ - Camlp4/Sig/Camlp4Ast.cmx \ - Camlp4/Sig/Ast.annot \ - Camlp4/Sig/Ast.cmi \ - Camlp4/Sig/Mapper.o \ - Camlp4/Sig/Mapper.annot \ - Camlp4/Sig/Mapper.cmo \ - Camlp4/Sig/Mapper.cmi \ - Camlp4/Sig/Mapper.cmx \ - Camlp4/Sig/Grammar.ml \ - Camlp4/Sig/Grammar.o \ - Camlp4/Sig/Grammar.cmo \ - Camlp4/Sig/Grammar.cmi \ - Camlp4/Sig/Grammar.cmx \ - Camlp4/Sig/Grammar/Static.annot \ - Camlp4/Sig/Grammar/Static.cmi \ - Camlp4/Sig/Grammar/Dynamic.annot \ - Camlp4/Sig/Grammar/Dynamic.cmi \ - Camlp4/Sig/Grammar/Structure.annot \ - Camlp4/Sig/Grammar/Structure.cmi \ - Camlp4/Sig/Grammar/Action.annot \ - Camlp4/Sig/Grammar/Action.cmi \ - Camlp4/Sig/Lexer.annot \ - Camlp4/Sig/Lexer.cmi \ - Camlp4/Sig/Token.annot \ - Camlp4/Sig/Token.cmi \ - Camlp4/Sig/Type.annot \ - Camlp4/Sig/Type.cmi \ - Camlp4/Sig/Warning.annot \ - Camlp4/Sig/Warning.cmi \ - Camlp4/Sig/Error.annot \ - Camlp4/Sig/Error.cmi \ - Camlp4/Sig/Loc.annot \ - Camlp4/Sig/Loc.cmi \ - Camlp4/Sig/Id.annot \ - Camlp4/Sig/Id.cmi \ - Camlp4/Options.o \ - Camlp4/Options.annot \ - Camlp4/Options.cmo \ - Camlp4/Options.cmi \ - Camlp4/Options.cmx \ - Camlp4/Debug.o \ - Camlp4/Debug.annot \ - Camlp4/Debug.cmo \ - Camlp4/Debug.cmi \ - Camlp4/Debug.cmx \ - Camlp4/Config.o \ - Camlp4/Config.annot \ - Camlp4/Config.cmo \ - Camlp4/Config.cmi \ - Camlp4/Config.cmx \ - build/camlp4_config.o \ - build/camlp4_config.annot \ - build/camlp4_config.cmo \ - build/camlp4_config.cmi \ - build/camlp4_config.cmx diff --git a/camlp4/boot/.cvsignore b/camlp4/boot/.cvsignore index b444f06cd..85599a4b5 100644 --- a/camlp4/boot/.cvsignore +++ b/camlp4/boot/.cvsignore @@ -3,4 +3,3 @@ camlp4 camlp4o camlp4r SAVED -camlp4boot.save.* diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml new file mode 100644 index 000000000..1909430e0 --- /dev/null +++ b/camlp4/boot/Camlp4.ml @@ -0,0 +1,16427 @@ +module Debug : + sig + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + (* camlp4r *) + type section = string + val mode : section -> bool + val printf : section -> ('a, Format.formatter, unit) format -> 'a + end = + struct + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + (* camlp4r *) + open Format + module Debug = struct let mode _ = false end + type section = string + let out_channel = + try + let f = Sys.getenv "CAMLP4_DEBUG_FILE" + in + open_out_gen [ Open_wronly; Open_creat; Open_append; Open_text ] + 0o666 f + with | Not_found -> stderr + module StringSet = Set.Make(String) + let mode = + try + let str = Sys.getenv "CAMLP4_DEBUG" in + let rec loop acc i = + try + let pos = String.index_from str i ':' + in + loop (StringSet.add (String.sub str i (pos - i)) acc) (pos + 1) + with + | Not_found -> + StringSet.add (String.sub str i ((String.length str) - i)) acc in + let sections = loop StringSet.empty 0 + in + if StringSet.mem "*" sections + then (fun _ -> true) + else (fun x -> StringSet.mem x sections) + with | Not_found -> (fun _ -> false) + let formatter = + let header = "camlp4-debug: " in + let normal s = + let rec self from accu = + try + let i = String.index_from s from '\n' + in self (i + 1) ((String.sub s from ((i - from) + 1)) :: accu) + with + | Not_found -> + (String.sub s from ((String.length s) - from)) :: accu + in String.concat header (List.rev (self 0 [])) in + let after_new_line str = header ^ (normal str) in + let f = ref after_new_line in + let output str chr = + (output_string out_channel (!f str); + output_char out_channel chr; + f := if chr = '\n' then after_new_line else normal) + in + make_formatter + (fun buf pos len -> + let p = pred len in output (String.sub buf pos p) buf.[pos + p]) + (fun () -> flush out_channel) + let printf section fmt = fprintf formatter ("%s: " ^^ fmt) section + end +module Options : + sig + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + type spec_list = (string * Arg.spec * string) list + val init : spec_list -> unit + val add : string -> Arg.spec -> string -> unit + (** Add an option to the command line options. *) + val print_usage_list : spec_list -> unit + val ext_spec_list : unit -> spec_list + val parse : (string -> unit) -> string array -> string list + end = + struct + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + type spec_list = (string * Arg.spec * string) list + open Format + let rec action_arg s sl = + function + | Arg.Unit f -> if s = "" then (f (); Some sl) else None + | Arg.Bool f -> + if s = "" + then + (match sl with + | s :: sl -> + (try (f (bool_of_string s); Some sl) + with | Invalid_argument "bool_of_string" -> None) + | [] -> None) + else + (try (f (bool_of_string s); Some sl) + with | Invalid_argument "bool_of_string" -> None) + | Arg.Set r -> if s = "" then (r := true; Some sl) else None + | Arg.Clear r -> if s = "" then (r := false; Some sl) else None + | Arg.Rest f -> (List.iter f (s :: sl); Some []) + | Arg.String f -> + if s = "" + then (match sl with | s :: sl -> (f s; Some sl) | [] -> None) + else (f s; Some sl) + | Arg.Set_string r -> + if s = "" + then (match sl with | s :: sl -> (r := s; Some sl) | [] -> None) + else (r := s; Some sl) + | Arg.Int f -> + if s = "" + then + (match sl with + | s :: sl -> + (try (f (int_of_string s); Some sl) + with | Failure "int_of_string" -> None) + | [] -> None) + else + (try (f (int_of_string s); Some sl) + with | Failure "int_of_string" -> None) + | Arg.Set_int r -> + if s = "" + then + (match sl with + | s :: sl -> + (try (r := int_of_string s; Some sl) + with | Failure "int_of_string" -> None) + | [] -> None) + else + (try (r := int_of_string s; Some sl) + with | Failure "int_of_string" -> None) + | Arg.Float f -> + if s = "" + then + (match sl with + | s :: sl -> (f (float_of_string s); Some sl) + | [] -> None) + else (f (float_of_string s); Some sl) + | Arg.Set_float r -> + if s = "" + then + (match sl with + | s :: sl -> (r := float_of_string s; Some sl) + | [] -> None) + else (r := float_of_string s; Some sl) + | Arg.Tuple specs -> + let rec action_args s sl = + (function + | [] -> Some sl + | spec :: spec_list -> + (match action_arg s sl spec with + | None -> action_args "" [] spec_list + | Some (s :: sl) -> action_args s sl spec_list + | Some sl -> action_args "" sl spec_list)) + in action_args s sl specs + | Arg.Symbol (syms, f) -> + (match if s = "" then sl else s :: sl with + | s :: sl when List.mem s syms -> (f s; Some sl) + | _ -> None) + let common_start s1 s2 = + let rec loop i = + if (i == (String.length s1)) || (i == (String.length s2)) + then i + else if s1.[i] == s2.[i] then loop (i + 1) else i + in loop 0 + let parse_arg fold s sl = + fold + (fun (name, action, _) acu -> + let i = common_start s name + in + if i == (String.length name) + then + (try + action_arg (String.sub s i ((String.length s) - i)) sl + action + with | Arg.Bad _ -> acu) + else acu) + None + let rec parse_aux fold anon_fun = + function + | [] -> [] + | s :: sl -> + if ((String.length s) > 1) && (s.[0] = '-') + then + (match parse_arg fold s sl with + | Some sl -> parse_aux fold anon_fun sl + | None -> s :: (parse_aux fold anon_fun sl)) + else ((anon_fun s : unit); parse_aux fold anon_fun sl) + let align_doc key s = + let s = + let rec loop i = + if i = (String.length s) + then "" + else + if s.[i] = ' ' + then loop (i + 1) + else String.sub s i ((String.length s) - i) + in loop 0 in + let (p, s) = + if (String.length s) > 0 + then + if s.[0] = '<' + then + (let rec loop i = + if i = (String.length s) + then ("", s) + else + if s.[i] <> '>' + then loop (i + 1) + else + (let p = String.sub s 0 (i + 1) in + let rec loop i = + if i >= (String.length s) + then (p, "") + else + if s.[i] = ' ' + then loop (i + 1) + else (p, (String.sub s i ((String.length s) - i))) + in loop (i + 1)) + in loop 0) + else ("", s) + else ("", "") in + let tab = + String.make (max 1 ((16 - (String.length key)) - (String.length p))) + ' ' + in p ^ (tab ^ s) + let make_symlist l = + match l with + | [] -> "<none>" + | h :: t -> + (List.fold_left (fun x y -> x ^ ("|" ^ y)) ("{" ^ h) t) ^ "}" + let print_usage_list l = + List.iter + (fun (key, spec, doc) -> + match spec with + | Arg.Symbol (symbs, _) -> + let s = make_symlist symbs in + let synt = key ^ (" " ^ s) + in eprintf " %s %s\n" synt (align_doc synt doc) + | _ -> eprintf " %s %s\n" key (align_doc key doc)) + l + let remaining_args argv = + let rec loop l i = + if i == (Array.length argv) then l else loop (argv.(i) :: l) (i + 1) + in List.rev (loop [] (!Arg.current + 1)) + let init_spec_list = ref [] + let ext_spec_list = ref [] + let init spec_list = init_spec_list := spec_list + let add name spec descr = + ext_spec_list := (name, spec, descr) :: !ext_spec_list + let fold f init = + let spec_list = !init_spec_list @ !ext_spec_list in + let specs = Sort.list (fun (k1, _, _) (k2, _, _) -> k1 >= k2) spec_list + in List.fold_right f specs init + let parse anon_fun argv = + let remaining_args = remaining_args argv + in parse_aux fold anon_fun remaining_args + let ext_spec_list () = !ext_spec_list + end +module Sig = + struct + (* camlp4r *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + module type Type = sig type t end + (** Signature for errors modules, an Error modules can be registred with + the {!ErrorHandler.Register} functor in order to be well printed. *) + module type Error = + sig + type t + exception E of t + val to_string : t -> string + val print : Format.formatter -> t -> unit + end + (** A signature for extensions identifiers. *) + module type Id = + sig + (** The name of the extension, typically the module name. *) + val name : string + (** The version of the extension, typically $Id: Id.mli,v 1.2 2006/07/08 17:21:31 pouillar Exp $ with a versionning system. *) + val version : string + end + module type Loc = + sig + type t + (** Return a start location for the given file name. + This location starts at the begining of the file. *) + val mk : string -> t + (** The [ghost] location can be used when no location + information is available. *) + val ghost : t + (** {6 Conversion functions} *) + (** Return a location where both positions are set the given position. *) + val of_lexing_position : Lexing.position -> t + (** Return an OCaml location. *) + val to_ocaml_location : t -> Location.t + (** Return a location from an OCaml location. *) + val of_ocaml_location : Location.t -> t + (** Return a location from ocamllex buffer. *) + val of_lexbuf : Lexing.lexbuf -> t + (** Return a location from [(file_name, start_line, start_bol, start_off, + stop_line, stop_bol, stop_off, ghost)]. *) + val of_tuple : + (string * int * int * int * int * int * int * bool) -> t + (** Return [(file_name, start_line, start_bol, start_off, + stop_line, stop_bol, stop_off, ghost)]. *) + val to_tuple : + t -> (string * int * int * int * int * int * int * bool) + (** [merge loc1 loc2] Return a location that starts at [loc1] and end at [loc2]. *) + val merge : t -> t -> t + (** The stop pos becomes equal to the start pos. *) + val join : t -> t + (** [move selector n loc] + Return the location where positions are moved. + Affected positions are chosen with [selector]. + Returned positions have their character offset plus [n]. *) + val move : [ `start | `stop | `both ] -> int -> t -> t + (** [shift n loc] Return the location where the new start position is the old + stop position, and where the new stop position character offset is the + old one plus [n]. *) + val shift : int -> t -> t + (** [move_line n loc] Return the location with the old line count plus [n]. + The "begin of line" of both positions become the current offset. *) + val move_line : int -> t -> t + (** Accessors *) + (** Return the file name *) + val file_name : t -> string + (** Return the line number of the begining of this location. *) + val start_line : t -> int + (** Return the line number of the ending of this location. *) + val stop_line : t -> int + (** Returns the number of characters from the begining of the file + to the begining of the line of location's begining. *) + val start_bol : t -> int + (** Returns the number of characters from the begining of the file + to the begining of the line of location's ending. *) + val stop_bol : t -> int + (** Returns the number of characters from the begining of the file + of the begining of this location. *) + val start_off : t -> int + (** Return the number of characters from the begining of the file + of the ending of this location. *) + val stop_off : t -> int + (** Return the start position as a Lexing.position. *) + val start_pos : t -> Lexing.position + (** Return the stop position as a Lexing.position. *) + val stop_pos : t -> Lexing.position + (** Generally, return true if this location does not come + from an input stream. *) + val is_ghost : t -> bool + (** Return the associated ghost location. *) + val ghostify : t -> t + (** Return the location with the give file name *) + val set_file_name : string -> t -> t + (** [strictly_before loc1 loc2] True if the stop position of [loc1] is + strictly_before the start position of [loc2]. *) + val strictly_before : t -> t -> bool + (** Return the location with an absolute file name. *) + val make_absolute : t -> t + (** Print the location into the formatter in a format suitable for error + reporting. *) + val print : Format.formatter -> t -> unit + (** Print the location in a short format useful for debugging. *) + val dump : Format.formatter -> t -> unit + (** Same as {!print} but return a string instead of printting it. *) + val to_string : t -> string + (** [Exc_located loc e] is an encapsulation of the exception [e] with + the input location [loc]. To be used in quotation expanders + and in grammars to specify some input location for an error. + Do not raise this exception directly: rather use the following + function [Loc.raise]. *) + exception Exc_located of t * exn + (** [raise loc e], if [e] is already an [Exc_located] exception, + re-raise it, else raise the exception [Exc_located loc e]. *) + val raise : t -> exn -> 'a + (** The name of the location variable used in grammars and in + the predefined quotations for OCaml syntax trees. Default: [_loc]. *) + val name : string ref + end + module type Warning = + sig + module Loc : Loc + type t = Loc.t -> string -> unit + val default : t + val current : t ref + val print : t + end + (** Base class for map traversal, it includes some builtin types. *) + class mapper = + (object method string = fun x -> (x : string) + method int = fun x -> (x : int) + method float = fun x -> (x : float) + method bool = fun x -> (x : bool) + method list : 'a 'b. ('a -> 'b) -> 'a list -> 'b list = List.map + method option : 'a 'b. ('a -> 'b) -> 'a option -> 'b option = + fun f -> function | None -> None | Some x -> Some (f x) + method array : 'a 'b. ('a -> 'b) -> 'a array -> 'b array = Array.map + method ref : 'a 'b. ('a -> 'b) -> 'a ref -> 'b ref = + fun f { contents = x } -> { contents = f x; } + end : + object + method string : string -> string + method int : int -> int + method float : float -> float + method bool : bool -> bool + method list : 'a 'b. ('a -> 'b) -> 'a list -> 'b list + method option : 'a 'b. ('a -> 'b) -> 'a option -> 'b option + method array : 'a 'b. ('a -> 'b) -> 'a array -> 'b array + method ref : 'a 'b. ('a -> 'b) -> 'a ref -> 'b ref + end) + (** Abstract syntax tree minimal signature. + Types of this signature are abstract. + See the {!Camlp4Ast} signature for a concrete definition. *) + module type Ast = + sig + module Loc : Loc + type meta_bool + type 'a meta_option + type ctyp + type patt + type expr + type module_type + type sig_item + type with_constr + type module_expr + type str_item + type class_type + type class_sig_item + type class_expr + type class_str_item + type match_case + type ident + type binding + type module_binding + val loc_of_ctyp : ctyp -> Loc.t + val loc_of_patt : patt -> Loc.t + val loc_of_expr : expr -> Loc.t + val loc_of_module_type : module_type -> Loc.t + val loc_of_module_expr : module_expr -> Loc.t + val loc_of_sig_item : sig_item -> Loc.t + val loc_of_str_item : str_item -> Loc.t + val loc_of_class_type : class_type -> Loc.t + val loc_of_class_sig_item : class_sig_item -> Loc.t + val loc_of_class_expr : class_expr -> Loc.t + val loc_of_class_str_item : class_str_item -> Loc.t + val loc_of_with_constr : with_constr -> Loc.t + val loc_of_binding : binding -> Loc.t + val loc_of_module_binding : module_binding -> Loc.t + val loc_of_match_case : match_case -> Loc.t + val loc_of_ident : ident -> Loc.t + (** This class is the base class for map traversal on the Ast. + To make a custom traversal class one just extend it like that: + + This example swap pairs expression contents: + open Camlp4.PreCast; + [class swap = object + inherit Ast.map as super; + method expr e = + match super#expr e with + \[ <:expr\@_loc< ($e1$, $e2$) >> -> <:expr< ($e2$, $e1$) >> + | e -> e \]; + end; + value _loc = Loc.ghost; + value map = (new swap)#expr; + assert (map <:expr< fun x -> (x, 42) >> = <:expr< fun x -> (42, x) >>);] + *) + class map : + object + inherit mapper + method meta_bool : meta_bool -> meta_bool + method meta_option : + 'a 'b. ('a -> 'b) -> 'a meta_option -> 'b meta_option + method _Loc_t : Loc.t -> Loc.t + method expr : expr -> expr + method patt : patt -> patt + method ctyp : ctyp -> ctyp + method str_item : str_item -> str_item + method sig_item : sig_item -> sig_item + method module_expr : module_expr -> module_expr + method module_type : module_type -> module_type + method class_expr : class_expr -> class_expr + method class_type : class_type -> class_type + method class_sig_item : class_sig_item -> class_sig_item + method class_str_item : class_str_item -> class_str_item + method with_constr : with_constr -> with_constr + method binding : binding -> binding + method module_binding : module_binding -> module_binding + method match_case : match_case -> match_case + method ident : ident -> ident + end + class fold : + object ('self_type) + method string : string -> 'self_type + method int : int -> 'self_type + method float : float -> 'self_type + method bool : bool -> 'self_type + method list : + 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type + method option : + 'a. ('self_type -> 'a -> 'self_type) -> 'a option -> 'self_type + method array : + 'a. ('self_type -> 'a -> 'self_type) -> 'a array -> 'self_type + method ref : + 'a. ('self_type -> 'a -> 'self_type) -> 'a ref -> 'self_type + method meta_bool : meta_bool -> 'self_type + method meta_option : + 'a. + ('self_type -> 'a -> 'self_type) -> + 'a meta_option -> 'self_type + method _Loc_t : Loc.t -> 'self_type + method expr : expr -> 'self_type + method patt : patt -> 'self_type + method ctyp : ctyp -> 'self_type + method str_item : str_item -> 'self_type + method sig_item : sig_item -> 'self_type + method module_expr : module_expr -> 'self_type + method module_type : module_type -> 'self_type + method class_expr : class_expr -> 'self_type + method class_type : class_type -> 'self_type + method class_sig_item : class_sig_item -> 'self_type + method class_str_item : class_str_item -> 'self_type + method with_constr : with_constr -> 'self_type + method binding : binding -> 'self_type + method module_binding : module_binding -> 'self_type + method match_case : match_case -> 'self_type + method ident : ident -> 'self_type + end + end + (** The AntiquotSyntax signature describe the minimal interface needed + for antiquotation handling. *) + module type AntiquotSyntax = + sig + module Ast : Ast + (** The parse function for expressions. + The underlying expression grammar entry is generally "expr; EOI". *) + val parse_expr : Ast.Loc.t -> string -> Ast.expr + (** The parse function for patterns. + The underlying pattern grammar entry is generally "patt; EOI". *) + val parse_patt : Ast.Loc.t -> string -> Ast.patt + end + (** Signature for OCaml syntax trees. + This signature is an extension of {!Ast} + It provides: + - Types for all kinds of structure. + - Map: A base class for map traversals. + - Map classes and functions for common kinds. *) + module type Camlp4Ast = + sig + module Loc : Loc + type meta_bool = | BTrue | BFalse | BAnt of string + type 'a meta_option = | ONone | OSome of 'a | OAnt of string + type ident = + | IdAcc of Loc.t * ident * ident | (* i . i *) + IdApp of Loc.t * ident * ident | (* i i *) IdLid of Loc.t * string + | (* foo *) IdUid of Loc.t * string | (* Bar *) + IdAnt of Loc.t * string + (* $s$ *) + type ctyp = + | TyNil of Loc.t | TyAli of Loc.t * ctyp * ctyp | (* t as t *) + (* list 'a as 'a *) TyAny of Loc.t | (* _ *) + TyApp of Loc.t * ctyp * ctyp | (* t t *) (* list 'a *) + TyArr of Loc.t * ctyp * ctyp | (* t -> t *) (* int -> string *) + TyCls of Loc.t * ident | (* #i *) (* #point *) + TyLab of Loc.t * string * ctyp | (* ~s *) TyId of Loc.t * ident + | (* i *) (* Lazy.t *) TyMan of Loc.t * ctyp * ctyp | (* t == t *) + (* type t = [ A | B ] == Foo.t *) + (* type t 'a 'b 'c = t constraint t = t constraint t = t *) + TyDcl of Loc.t * string * ctyp list * ctyp * (ctyp * ctyp) list + | (* < (t)? (..)? > *) (* < move : int -> 'a .. > as 'a *) + TyObj of Loc.t * ctyp * meta_bool | TyOlb of Loc.t * string * ctyp + | (* ?s *) TyPol of Loc.t * ctyp * ctyp | (* ! t . t *) + (* ! 'a . list 'a -> 'a *) TyQuo of Loc.t * string | (* 's *) + TyQuP of Loc.t * string | (* +'s *) TyQuM of Loc.t * string + | (* -'s *) TyVrn of Loc.t * string | (* `s *) + TyRec of Loc.t * ctyp | (* { t } *) + (* { foo : int ; bar : mutable string } *) + TyCol of Loc.t * ctyp * ctyp | (* t : t *) + TySem of Loc.t * ctyp * ctyp | (* t; t *) + TyCom of Loc.t * ctyp * ctyp | (* t, t *) TySum of Loc.t * ctyp + | (* [ t ] *) (* [ A of int and string | B ] *) + TyOf of Loc.t * ctyp * ctyp | (* t of t *) (* A of int *) + TyAnd of Loc.t * ctyp * ctyp | (* t and t *) + TyOr of Loc.t * ctyp * ctyp | (* t | t *) TyPrv of Loc.t * ctyp + | (* private t *) TyMut of Loc.t * ctyp | (* mutable t *) + TyTup of Loc.t * ctyp | (* ( t ) *) (* (int * string) *) + TySta of Loc.t * ctyp * ctyp | (* t * t *) TyVrnEq of Loc.t * ctyp + | (* [ = t ] *) TyVrnSup of Loc.t * ctyp | (* [ > t ] *) + TyVrnInf of Loc.t * ctyp | (* [ < t ] *) + TyVrnInfSup of Loc.t * ctyp * ctyp | (* [ < t > t ] *) + TyAmp of Loc.t * ctyp * ctyp | (* t & t *) + TyOfAmp of Loc.t * ctyp * ctyp | (* t of & t *) + TyAnt of Loc.t * string + (* $s$ *) + type (* i *) + (* p as p *) + (* (Node x y as n) *) + (* $s$ *) + (* _ *) + (* p p *) + (* fun x y -> *) + (* [| p |] *) + (* p, p *) + (* p; p *) + (* c *) + (* 'x' *) + (* ~s or ~s:(p) *) + (* ?s or ?s:(p = e) or ?(p = e) *) + (* | PaOlb of Loc.t and string and meta_option(*FIXME*) (patt * meta_option(*FIXME*) expr) *) + (* ?s or ?s:(p) *) + (* ?s:(p = e) or ?(p = e) *) + (* p | p *) + (* p .. p *) + (* { p } *) + (* p = p *) + (* s *) + (* ( p ) *) + (* (p : t) *) + (* #i *) + (* `s *) + (* i *) + (* e.e *) + (* $s$ *) + (* e e *) + (* e.(e) *) + (* [| e |] *) + (* e; e *) + (* assert False *) + (* assert e *) + (* e := e *) + (* 'c' *) + (* (e : t) or (e : t :> t) *) + (* 3.14 *) + (* for s = e to/downto e do { e } *) + (* fun [ a ] *) + (* if e then e else e *) + (* 42 *) + (* ~s or ~s:e *) + (* lazy e *) + (* let b in e or let rec b in e *) + (* let module s = me in e *) + (* match e with [ a ] *) + (* new i *) + (* object ((p))? (cst)? end *) + (* ?s or ?s:e *) + (* {< b >} *) + (* { b } or { (e) with b } *) + (* do { e } *) + (* e#s *) + (* e.[e] *) + (* s *) + (* "foo" *) + (* try e with [ a ] *) + (* (e) *) + (* e, e *) + (* (e : t) *) + (* `s *) + (* while e do { e } *) + (* i *) + (* A.B.C *) + (* functor (s : mt) -> mt *) + (* 's *) + (* sig (sg)? end *) + (* mt with wc *) + (* $s$ *) + (* class cict *) + (* class type cict *) + (* sg ; sg *) + (* # s or # s e *) + (* exception t *) + (* |+ external s : t = s ... s +| + | SgExt of Loc.t and string and ctyp and list string *) + (* external s : t = s *) + (* include mt *) + (* module s : mt *) + (* module rec mb *) + (* module type s = mt *) + (* open i *) + (* type t *) + (* value s : t *) + (* $s$ *) + (* type t = t *) + (* module i = i *) + (* wc and wc *) + (* $s$ *) + (* b and b *) + (* let a = 42 and c = 43 *) + (* b ; b *) + (* p = e *) + (* let patt = expr *) + (* $s$ *) + (* mb and mb *) + (* module rec (s : mt) = me and (s : mt) = me *) + (* s : mt = me *) + (* s : mt *) + (* $s$ *) + (* a | a *) + (* p (when e)? -> e *) + (* $s$ *) + (* i *) + (* me me *) + (* functor (s : mt) -> me *) + (* struct (st)? end *) + (* (me : mt) *) + (* $s$ *) + (* class cice *) + (* class type cict *) + (* st ; st *) + (* # s or # s e *) + (* exception t or exception t = i *) + (*FIXME*) + (* e *) + (* |+ external s : t = s ... s +| + | StExt of Loc.t and string and ctyp and list string *) + (* external s : t = s *) + (* include me *) + (* module s = me *) + (* module rec mb *) + (* module type s = mt *) + (* open i *) + (* type t *) + (* value b or value rec b *) + (* $s$ *) + (* (virtual)? i ([ t ])? *) + (* [t] -> ct *) + (* object ((t))? (csg)? end *) + (* ct and ct *) + (* ct : ct *) + (* ct = ct *) + (* $s$ *) + (* type t = t *) + (* csg ; csg *) + (* inherit ct *) + (* method s : t or method private s : t *) + (* value (virtual)? (mutable)? s : t *) + (* method virtual (mutable)? s : t *) + (* $s$ *) + (* ce e *) + (* (virtual)? i ([ t ])? *) + (* fun p -> ce *) + (* let (rec)? b in ce *) + (* object ((p))? (cst)? end *) + (* ce : ct *) + (* ce and ce *) + (* ce = ce *) + (* $s$ *) + patt = + | PaNil of Loc.t | PaId of Loc.t * ident + | PaAli of Loc.t * patt * patt | PaAnt of Loc.t * string + | PaAny of Loc.t | PaApp of Loc.t * patt * patt + | PaArr of Loc.t * patt | PaCom of Loc.t * patt * patt + | PaSem of Loc.t * patt * patt | PaChr of Loc.t * string + | PaInt of Loc.t * string | PaInt32 of Loc.t * string + | PaInt64 of Loc.t * string | PaNativeInt of Loc.t * string + | PaFlo of Loc.t * string | PaLab of Loc.t * string * patt + | PaOlb of Loc.t * string * patt + | PaOlbi of Loc.t * string * patt * expr + | PaOrp of Loc.t * patt * patt | PaRng of Loc.t * patt * patt + | PaRec of Loc.t * patt | PaEq of Loc.t * patt * patt + | PaStr of Loc.t * string | PaTup of Loc.t * patt + | PaTyc of Loc.t * patt * ctyp | PaTyp of Loc.t * ident + | PaVrn of Loc.t * string + and expr = + | ExNil of Loc.t | ExId of Loc.t * ident + | ExAcc of Loc.t * expr * expr | ExAnt of Loc.t * string + | ExApp of Loc.t * expr * expr | ExAre of Loc.t * expr * expr + | ExArr of Loc.t * expr | ExSem of Loc.t * expr * expr + | ExAsf of Loc.t | ExAsr of Loc.t * expr + | ExAss of Loc.t * expr * expr | ExChr of Loc.t * string + | ExCoe of Loc.t * expr * ctyp * ctyp | ExFlo of Loc.t * string + | ExFor of Loc.t * string * expr * expr * meta_bool * expr + | ExFun of Loc.t * match_case | ExIfe of Loc.t * expr * expr * expr + | ExInt of Loc.t * string | ExInt32 of Loc.t * string + | ExInt64 of Loc.t * string | ExNativeInt of Loc.t * string + | ExLab of Loc.t * string * expr | ExLaz of Loc.t * expr + | ExLet of Loc.t * meta_bool * binding * expr + | ExLmd of Loc.t * string * module_expr * expr + | ExMat of Loc.t * expr * match_case | ExNew of Loc.t * ident + | ExObj of Loc.t * patt * class_str_item + | ExOlb of Loc.t * string * expr | ExOvr of Loc.t * binding + | ExRec of Loc.t * binding * expr | ExSeq of Loc.t * expr + | ExSnd of Loc.t * expr * string | ExSte of Loc.t * expr * expr + | ExStr of Loc.t * string | ExTry of Loc.t * expr * match_case + | ExTup of Loc.t * expr | ExCom of Loc.t * expr * expr + | ExTyc of Loc.t * expr * ctyp | ExVrn of Loc.t * string + | ExWhi of Loc.t * expr * expr + and module_type = + | MtId of Loc.t * ident + | MtFun of Loc.t * string * module_type * module_type + | MtQuo of Loc.t * string | MtSig of Loc.t * sig_item + | MtWit of Loc.t * module_type * with_constr + | MtAnt of Loc.t * string + and sig_item = + | SgNil of Loc.t | SgCls of Loc.t * class_type + | SgClt of Loc.t * class_type + | SgSem of Loc.t * sig_item * sig_item + | SgDir of Loc.t * string * expr | SgExc of Loc.t * ctyp + | SgExt of Loc.t * string * ctyp * string + | SgInc of Loc.t * module_type + | SgMod of Loc.t * string * module_type + | SgRecMod of Loc.t * module_binding + | SgMty of Loc.t * string * module_type | SgOpn of Loc.t * ident + | SgTyp of Loc.t * ctyp | SgVal of Loc.t * string * ctyp + | SgAnt of Loc.t * string + and with_constr = + | WcNil of Loc.t | WcTyp of Loc.t * ctyp * ctyp + | WcMod of Loc.t * ident * ident + | WcAnd of Loc.t * with_constr * with_constr + | WcAnt of Loc.t * string + and binding = + | BiNil of Loc.t | BiAnd of Loc.t * binding * binding + | BiSem of Loc.t * binding * binding | BiEq of Loc.t * patt * expr + | BiAnt of Loc.t * string + and module_binding = + | MbNil of Loc.t | MbAnd of Loc.t * module_binding * module_binding + | MbColEq of Loc.t * string * module_type * module_expr + | MbCol of Loc.t * string * module_type | MbAnt of Loc.t * string + and match_case = + | McNil of Loc.t | McOr of Loc.t * match_case * match_case + | McArr of Loc.t * patt * expr * expr | McAnt of Loc.t * string + and module_expr = + | MeId of Loc.t * ident + | MeApp of Loc.t * module_expr * module_expr + | MeFun of Loc.t * string * module_type * module_expr + | MeStr of Loc.t * str_item + | MeTyc of Loc.t * module_expr * module_type + | MeAnt of Loc.t * string + and str_item = + | StNil of Loc.t | StCls of Loc.t * class_expr + | StClt of Loc.t * class_type + | StSem of Loc.t * str_item * str_item + | StDir of Loc.t * string * expr + | StExc of Loc.t * ctyp * ident meta_option | StExp of Loc.t * expr + | StExt of Loc.t * string * ctyp * string + | StInc of Loc.t * module_expr + | StMod of Loc.t * string * module_expr + | StRecMod of Loc.t * module_binding + | StMty of Loc.t * string * module_type | StOpn of Loc.t * ident + | StTyp of Loc.t * ctyp | StVal of Loc.t * meta_bool * binding + | StAnt of Loc.t * string + and class_type = + | CtNil of Loc.t | CtCon of Loc.t * meta_bool * ident * ctyp + | CtFun of Loc.t * ctyp * class_type + | CtSig of Loc.t * ctyp * class_sig_item + | CtAnd of Loc.t * class_type * class_type + | CtCol of Loc.t * class_type * class_type + | CtEq of Loc.t * class_type * class_type | CtAnt of Loc.t * string + and class_sig_item = + | CgNil of Loc.t | CgCtr of Loc.t * ctyp * ctyp + | CgSem of Loc.t * class_sig_item * class_sig_item + | CgInh of Loc.t * class_type + | CgMth of Loc.t * string * meta_bool * ctyp + | CgVal of Loc.t * string * meta_bool * meta_bool * ctyp + | CgVir of Loc.t * string * meta_bool * ctyp + | CgAnt of Loc.t * string + and class_expr = + | CeNil of Loc.t | CeApp of Loc.t * class_expr * expr + | CeCon of Loc.t * meta_bool * ident * ctyp + | CeFun of Loc.t * patt * class_expr + | CeLet of Loc.t * meta_bool * binding * class_expr + | CeStr of Loc.t * patt * class_str_item + | CeTyc of Loc.t * class_expr * class_type + | CeAnd of Loc.t * class_expr * class_expr + | CeEq of Loc.t * class_expr * class_expr | CeAnt of Loc.t * string + and class_str_item = + | CrNil of Loc.t | (* cst ; cst *) + CrSem of Loc.t * class_str_item * class_str_item | (* type t = t *) + CrCtr of Loc.t * ctyp * ctyp | (* inherit ce or inherit ce as s *) + CrInh of Loc.t * class_expr * string | (* initializer e *) + CrIni of Loc.t * expr + | (* method (private)? s : t = e or method (private)? s = e *) + CrMth of Loc.t * string * meta_bool * expr * ctyp + | (* value (mutable)? s = e *) + CrVal of Loc.t * string * meta_bool * expr + | (* method virtual (private)? s : t *) + CrVir of Loc.t * string * meta_bool * ctyp + | (* value virtual (private)? s : t *) + CrVvr of Loc.t * string * meta_bool * ctyp + | CrAnt of Loc.t * string + val loc_of_ctyp : ctyp -> Loc.t + val loc_of_patt : patt -> Loc.t + val loc_of_expr : expr -> Loc.t + val loc_of_module_type : module_type -> Loc.t + val loc_of_module_expr : module_expr -> Loc.t + val loc_of_sig_item : sig_item -> Loc.t + val loc_of_str_item : str_item -> Loc.t + val loc_of_class_type : class_type -> Loc.t + val loc_of_class_sig_item : class_sig_item -> Loc.t + val loc_of_class_expr : class_expr -> Loc.t + val loc_of_class_str_item : class_str_item -> Loc.t + val loc_of_with_constr : with_constr -> Loc.t + val loc_of_binding : binding -> Loc.t + val loc_of_module_binding : module_binding -> Loc.t + val loc_of_match_case : match_case -> Loc.t + val loc_of_ident : ident -> Loc.t + module Meta : + sig + module type META_LOC = + sig + val meta_loc_patt : Loc.t -> Loc.t -> patt + val meta_loc_expr : Loc.t -> Loc.t -> expr + end + module MetaLoc : + sig + val meta_loc_patt : Loc.t -> Loc.t -> patt + val meta_loc_expr : Loc.t -> Loc.t -> expr + end + module MetaGhostLoc : + sig + val meta_loc_patt : Loc.t -> 'a -> patt + val meta_loc_expr : Loc.t -> 'a -> expr + end + module MetaLocVar : + sig + val meta_loc_patt : Loc.t -> 'a -> patt + val meta_loc_expr : Loc.t -> 'a -> expr + end + module Make (MetaLoc : META_LOC) : + sig + module Expr : + sig + val meta_string : Loc.t -> string -> expr + val meta_int : Loc.t -> string -> expr + val meta_float : Loc.t -> string -> expr + val meta_char : Loc.t -> string -> expr + val meta_bool : Loc.t -> bool -> expr + val meta_list : + (Loc.t -> 'a -> expr) -> Loc.t -> 'a list -> expr + val meta_binding : Loc.t -> binding -> expr + val meta_class_expr : Loc.t -> class_expr -> expr + val meta_class_sig_item : Loc.t -> class_sig_item -> expr + val meta_class_str_item : Loc.t -> class_str_item -> expr + val meta_class_type : Loc.t -> class_type -> expr + val meta_ctyp : Loc.t -> ctyp -> expr + val meta_expr : Loc.t -> expr -> expr + val meta_ident : Loc.t -> ident -> expr + val meta_match_case : Loc.t -> match_case -> expr + val meta_meta_bool : Loc.t -> meta_bool -> expr + val meta_meta_option : + (Loc.t -> ident -> expr) -> + Loc.t -> ident meta_option -> expr + val meta_module_binding : Loc.t -> module_binding -> expr + val meta_module_expr : Loc.t -> module_expr -> expr + val meta_module_type : Loc.t -> module_type -> expr + val meta_patt : Loc.t -> patt -> expr + val meta_sig_item : Loc.t -> sig_item -> expr + val meta_str_item : Loc.t -> str_item -> expr + val meta_with_constr : Loc.t -> with_constr -> expr + end + module Patt : + sig + val meta_string : Loc.t -> string -> patt + val meta_int : Loc.t -> string -> patt + val meta_float : Loc.t -> string -> patt + val meta_char : Loc.t -> string -> patt + val meta_bool : Loc.t -> bool -> patt + val meta_list : + (Loc.t -> 'a -> patt) -> Loc.t -> 'a list -> patt + val meta_binding : Loc.t -> binding -> patt + val meta_class_expr : Loc.t -> class_expr -> patt + val meta_class_sig_item : Loc.t -> class_sig_item -> patt + val meta_class_str_item : Loc.t -> class_str_item -> patt + val meta_class_type : Loc.t -> class_type -> patt + val meta_ctyp : Loc.t -> ctyp -> patt + val meta_expr : Loc.t -> expr -> patt + val meta_ident : Loc.t -> ident -> patt + val meta_match_case : Loc.t -> match_case -> patt + val meta_meta_bool : Loc.t -> meta_bool -> patt + val meta_meta_option : + (Loc.t -> ident -> patt) -> + Loc.t -> ident meta_option -> patt + val meta_module_binding : Loc.t -> module_binding -> patt + val meta_module_expr : Loc.t -> module_expr -> patt + val meta_module_type : Loc.t -> module_type -> patt + val meta_patt : Loc.t -> patt -> patt + val meta_sig_item : Loc.t -> sig_item -> patt + val meta_str_item : Loc.t -> str_item -> patt + val meta_with_constr : Loc.t -> with_constr -> patt + end + end + end + class map : + object + inherit mapper + method meta_bool : meta_bool -> meta_bool + method meta_option : + 'a 'b. ('a -> 'b) -> 'a meta_option -> 'b meta_option + method _Loc_t : Loc.t -> Loc.t + method expr : expr -> expr + method patt : patt -> patt + method ctyp : ctyp -> ctyp + method str_item : str_item -> str_item + method sig_item : sig_item -> sig_item + method module_expr : module_expr -> module_expr + method module_type : module_type -> module_type + method class_expr : class_expr -> class_expr + method class_type : class_type -> class_type + method class_sig_item : class_sig_item -> class_sig_item + method class_str_item : class_str_item -> class_str_item + method with_constr : with_constr -> with_constr + method binding : binding -> binding + method module_binding : module_binding -> module_binding + method match_case : match_case -> match_case + method ident : ident -> ident + end + class fold : + object ('self_type) + method string : string -> 'self_type + method int : int -> 'self_type + method float : float -> 'self_type + method bool : bool -> 'self_type + method list : + 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type + method option : + 'a. ('self_type -> 'a -> 'self_type) -> 'a option -> 'self_type + method array : + 'a. ('self_type -> 'a -> 'self_type) -> 'a array -> 'self_type + method ref : + 'a. ('self_type -> 'a -> 'self_type) -> 'a ref -> 'self_type + method meta_bool : meta_bool -> 'self_type + method meta_option : + 'a. + ('self_type -> 'a -> 'self_type) -> + 'a meta_option -> 'self_type + method _Loc_t : Loc.t -> 'self_type + method expr : expr -> 'self_type + method patt : patt -> 'self_type + method ctyp : ctyp -> 'self_type + method str_item : str_item -> 'self_type + method sig_item : sig_item -> 'self_type + method module_expr : module_expr -> 'self_type + method module_type : module_type -> 'self_type + method class_expr : class_expr -> 'self_type + method class_type : class_type -> 'self_type + method class_sig_item : class_sig_item -> 'self_type + method class_str_item : class_str_item -> 'self_type + method with_constr : with_constr -> 'self_type + method binding : binding -> 'self_type + method module_binding : module_binding -> 'self_type + method match_case : match_case -> 'self_type + method ident : ident -> 'self_type + end + class c_expr : (expr -> expr) -> object inherit map end + class c_patt : (patt -> patt) -> object inherit map end + class c_ctyp : (ctyp -> ctyp) -> object inherit map end + class c_str_item : (str_item -> str_item) -> object inherit map end + class c_sig_item : (sig_item -> sig_item) -> object inherit map end + class c_loc : (Loc.t -> Loc.t) -> object inherit map end + val map_expr : (expr -> expr) -> expr -> expr + val map_patt : (patt -> patt) -> patt -> patt + val map_ctyp : (ctyp -> ctyp) -> ctyp -> ctyp + val map_str_item : (str_item -> str_item) -> str_item -> str_item + val map_sig_item : (sig_item -> sig_item) -> sig_item -> sig_item + val map_loc : (Loc.t -> Loc.t) -> Loc.t -> Loc.t + val ident_of_expr : expr -> ident + val ident_of_ctyp : ctyp -> ident + val biAnd_of_list : binding list -> binding + val biSem_of_list : binding list -> binding + val paSem_of_list : patt list -> patt + val paCom_of_list : patt list -> patt + val tyOr_of_list : ctyp list -> ctyp + val tyAnd_of_list : ctyp list -> ctyp + val tySem_of_list : ctyp list -> ctyp + val stSem_of_list : str_item list -> str_item + val sgSem_of_list : sig_item list -> sig_item + val crSem_of_list : class_str_item list -> class_str_item + val cgSem_of_list : class_sig_item list -> class_sig_item + val ctAnd_of_list : class_type list -> class_type + val ceAnd_of_list : class_expr list -> class_expr + val wcAnd_of_list : with_constr list -> with_constr + val meApp_of_list : module_expr list -> module_expr + val mbAnd_of_list : module_binding list -> module_binding + val mcOr_of_list : match_case list -> match_case + val idAcc_of_list : ident list -> ident + val idApp_of_list : ident list -> ident + val exSem_of_list : expr list -> expr + val exCom_of_list : expr list -> expr + val list_of_ctyp : ctyp -> ctyp list -> ctyp list + val list_of_binding : binding -> binding list -> binding list + val list_of_with_constr : + with_constr -> with_constr list -> with_constr list + val list_of_patt : patt -> patt list -> patt list + val list_of_expr : expr -> expr list -> expr list + val list_of_str_item : str_item -> str_item list -> str_item list + val list_of_sig_item : sig_item -> sig_item list -> sig_item list + val list_of_class_sig_item : + class_sig_item -> class_sig_item list -> class_sig_item list + val list_of_class_str_item : + class_str_item -> class_str_item list -> class_str_item list + val list_of_class_type : + class_type -> class_type list -> class_type list + val list_of_class_expr : + class_expr -> class_expr list -> class_expr list + val list_of_module_expr : + module_expr -> module_expr list -> module_expr list + val list_of_module_binding : + module_binding -> module_binding list -> module_binding list + val list_of_match_case : + match_case -> match_case list -> match_case list + val list_of_ident : ident -> ident list -> ident list + val safe_string_escaped : string -> string + val is_irrefut_patt : patt -> bool + val is_constructor : ident -> bool + val is_patt_constructor : patt -> bool + val is_expr_constructor : expr -> bool + val ty_of_stl : (Loc.t * string * (ctyp list)) -> ctyp + val ty_of_sbt : (Loc.t * string * bool * ctyp) -> ctyp + val bi_of_pe : (patt * expr) -> binding + val pel_of_binding : binding -> (patt * expr) list + val binding_of_pel : (patt * expr) list -> binding + val sum_type_of_list : (Loc.t * string * (ctyp list)) list -> ctyp + val record_type_of_list : (Loc.t * string * bool * ctyp) list -> ctyp + end + module Camlp4AstToAst (M : Camlp4Ast) : Ast with module Loc = M.Loc + and type meta_bool = M.meta_bool + and type 'a meta_option = 'a M.meta_option and type ctyp = M.ctyp + and type patt = M.patt and type expr = M.expr + and type module_type = M.module_type and type sig_item = M.sig_item + and type with_constr = M.with_constr + and type module_expr = M.module_expr and type str_item = M.str_item + and type class_type = M.class_type + and type class_sig_item = M.class_sig_item + and type class_expr = M.class_expr + and type class_str_item = M.class_str_item and type binding = M.binding + and type module_binding = M.module_binding + and type match_case = M.match_case and type ident = M.ident = M + module MakeCamlp4Ast (Loc : Type) = + struct + type meta_bool = | BTrue | BFalse | BAnt of string + type 'a meta_option = | ONone | OSome of 'a | OAnt of string + type ident = + | IdAcc of Loc.t * ident * ident | IdApp of Loc.t * ident * ident + | IdLid of Loc.t * string | IdUid of Loc.t * string + | IdAnt of Loc.t * string + type ctyp = + | TyNil of Loc.t | TyAli of Loc.t * ctyp * ctyp | TyAny of Loc.t + | TyApp of Loc.t * ctyp * ctyp | TyArr of Loc.t * ctyp * ctyp + | TyCls of Loc.t * ident | TyLab of Loc.t * string * ctyp + | TyId of Loc.t * ident | TyMan of Loc.t * ctyp * ctyp + | TyDcl of Loc.t * string * ctyp list * ctyp * (ctyp * ctyp) list + | TyObj of Loc.t * ctyp * meta_bool + | TyOlb of Loc.t * string * ctyp | TyPol of Loc.t * ctyp * ctyp + | TyQuo of Loc.t * string | TyQuP of Loc.t * string + | TyQuM of Loc.t * string | TyVrn of Loc.t * string + | TyRec of Loc.t * ctyp | TyCol of Loc.t * ctyp * ctyp + | TySem of Loc.t * ctyp * ctyp | TyCom of Loc.t * ctyp * ctyp + | TySum of Loc.t * ctyp | TyOf of Loc.t * ctyp * ctyp + | TyAnd of Loc.t * ctyp * ctyp | TyOr of Loc.t * ctyp * ctyp + | TyPrv of Loc.t * ctyp | TyMut of Loc.t * ctyp + | TyTup of Loc.t * ctyp | TySta of Loc.t * ctyp * ctyp + | TyVrnEq of Loc.t * ctyp | TyVrnSup of Loc.t * ctyp + | TyVrnInf of Loc.t * ctyp | TyVrnInfSup of Loc.t * ctyp * ctyp + | TyAmp of Loc.t * ctyp * ctyp | TyOfAmp of Loc.t * ctyp * ctyp + | TyAnt of Loc.t * string + type patt = + | PaNil of Loc.t | PaId of Loc.t * ident + | PaAli of Loc.t * patt * patt | PaAnt of Loc.t * string + | PaAny of Loc.t | PaApp of Loc.t * patt * patt + | PaArr of Loc.t * patt | PaCom of Loc.t * patt * patt + | PaSem of Loc.t * patt * patt | PaChr of Loc.t * string + | PaInt of Loc.t * string | PaInt32 of Loc.t * string + | PaInt64 of Loc.t * string | PaNativeInt of Loc.t * string + | PaFlo of Loc.t * string | PaLab of Loc.t * string * patt + | PaOlb of Loc.t * string * patt + | PaOlbi of Loc.t * string * patt * expr + | PaOrp of Loc.t * patt * patt | PaRng of Loc.t * patt * patt + | PaRec of Loc.t * patt | PaEq of Loc.t * patt * patt + | PaStr of Loc.t * string | PaTup of Loc.t * patt + | PaTyc of Loc.t * patt * ctyp | PaTyp of Loc.t * ident + | PaVrn of Loc.t * string + and expr = + | ExNil of Loc.t | ExId of Loc.t * ident + | ExAcc of Loc.t * expr * expr | ExAnt of Loc.t * string + | ExApp of Loc.t * expr * expr | ExAre of Loc.t * expr * expr + | ExArr of Loc.t * expr | ExSem of Loc.t * expr * expr + | ExAsf of Loc.t | ExAsr of Loc.t * expr + | ExAss of Loc.t * expr * expr | ExChr of Loc.t * string + | ExCoe of Loc.t * expr * ctyp * ctyp | ExFlo of Loc.t * string + | ExFor of Loc.t * string * expr * expr * meta_bool * expr + | ExFun of Loc.t * match_case | ExIfe of Loc.t * expr * expr * expr + | ExInt of Loc.t * string | ExInt32 of Loc.t * string + | ExInt64 of Loc.t * string | ExNativeInt of Loc.t * string + | ExLab of Loc.t * string * expr | ExLaz of Loc.t * expr + | ExLet of Loc.t * meta_bool * binding * expr + | ExLmd of Loc.t * string * module_expr * expr + | ExMat of Loc.t * expr * match_case | ExNew of Loc.t * ident + | ExObj of Loc.t * patt * class_str_item + | ExOlb of Loc.t * string * expr | ExOvr of Loc.t * binding + | ExRec of Loc.t * binding * expr | ExSeq of Loc.t * expr + | ExSnd of Loc.t * expr * string | ExSte of Loc.t * expr * expr + | ExStr of Loc.t * string | ExTry of Loc.t * expr * match_case + | ExTup of Loc.t * expr | ExCom of Loc.t * expr * expr + | ExTyc of Loc.t * expr * ctyp | ExVrn of Loc.t * string + | ExWhi of Loc.t * expr * expr + and module_type = + | MtId of Loc.t * ident + | MtFun of Loc.t * string * module_type * module_type + | MtQuo of Loc.t * string | MtSig of Loc.t * sig_item + | MtWit of Loc.t * module_type * with_constr + | MtAnt of Loc.t * string + and sig_item = + | SgNil of Loc.t | SgCls of Loc.t * class_type + | SgClt of Loc.t * class_type + | SgSem of Loc.t * sig_item * sig_item + | SgDir of Loc.t * string * expr | SgExc of Loc.t * ctyp + | SgExt of Loc.t * string * ctyp * string + | SgInc of Loc.t * module_type + | SgMod of Loc.t * string * module_type + | SgRecMod of Loc.t * module_binding + | SgMty of Loc.t * string * module_type | SgOpn of Loc.t * ident + | SgTyp of Loc.t * ctyp | SgVal of Loc.t * string * ctyp + | SgAnt of Loc.t * string + and with_constr = + | WcNil of Loc.t | WcTyp of Loc.t * ctyp * ctyp + | WcMod of Loc.t * ident * ident + | WcAnd of Loc.t * with_constr * with_constr + | WcAnt of Loc.t * string + and binding = + | BiNil of Loc.t | BiAnd of Loc.t * binding * binding + | BiSem of Loc.t * binding * binding | BiEq of Loc.t * patt * expr + | BiAnt of Loc.t * string + and module_binding = + | MbNil of Loc.t | MbAnd of Loc.t * module_binding * module_binding + | MbColEq of Loc.t * string * module_type * module_expr + | MbCol of Loc.t * string * module_type | MbAnt of Loc.t * string + and match_case = + | McNil of Loc.t | McOr of Loc.t * match_case * match_case + | McArr of Loc.t * patt * expr * expr | McAnt of Loc.t * string + and module_expr = + | MeId of Loc.t * ident + | MeApp of Loc.t * module_expr * module_expr + | MeFun of Loc.t * string * module_type * module_expr + | MeStr of Loc.t * str_item + | MeTyc of Loc.t * module_expr * module_type + | MeAnt of Loc.t * string + and str_item = + | StNil of Loc.t | StCls of Loc.t * class_expr + | StClt of Loc.t * class_type + | StSem of Loc.t * str_item * str_item + | StDir of Loc.t * string * expr + | StExc of Loc.t * ctyp * ident meta_option | StExp of Loc.t * expr + | StExt of Loc.t * string * ctyp * string + | StInc of Loc.t * module_expr + | StMod of Loc.t * string * module_expr + | StRecMod of Loc.t * module_binding + | StMty of Loc.t * string * module_type | StOpn of Loc.t * ident + | StTyp of Loc.t * ctyp | StVal of Loc.t * meta_bool * binding + | StAnt of Loc.t * string + and class_type = + | CtNil of Loc.t | CtCon of Loc.t * meta_bool * ident * ctyp + | CtFun of Loc.t * ctyp * class_type + | CtSig of Loc.t * ctyp * class_sig_item + | CtAnd of Loc.t * class_type * class_type + | CtCol of Loc.t * class_type * class_type + | CtEq of Loc.t * class_type * class_type | CtAnt of Loc.t * string + and class_sig_item = + | CgNil of Loc.t | CgCtr of Loc.t * ctyp * ctyp + | CgSem of Loc.t * class_sig_item * class_sig_item + | CgInh of Loc.t * class_type + | CgMth of Loc.t * string * meta_bool * ctyp + | CgVal of Loc.t * string * meta_bool * meta_bool * ctyp + | CgVir of Loc.t * string * meta_bool * ctyp + | CgAnt of Loc.t * string + and class_expr = + | CeNil of Loc.t | CeApp of Loc.t * class_expr * expr + | CeCon of Loc.t * meta_bool * ident * ctyp + | CeFun of Loc.t * patt * class_expr + | CeLet of Loc.t * meta_bool * binding * class_expr + | CeStr of Loc.t * patt * class_str_item + | CeTyc of Loc.t * class_expr * class_type + | CeAnd of Loc.t * class_expr * class_expr + | CeEq of Loc.t * class_expr * class_expr | CeAnt of Loc.t * string + and class_str_item = + | CrNil of Loc.t | CrSem of Loc.t * class_str_item * class_str_item + | CrCtr of Loc.t * ctyp * ctyp + | CrInh of Loc.t * class_expr * string | CrIni of Loc.t * expr + | CrMth of Loc.t * string * meta_bool * expr * ctyp + | CrVal of Loc.t * string * meta_bool * expr + | CrVir of Loc.t * string * meta_bool * ctyp + | CrVvr of Loc.t * string * meta_bool * ctyp + | CrAnt of Loc.t * string + end + module type AstFilters = + sig + module Ast : Camlp4Ast + type 'a filter = 'a -> 'a + val register_sig_item_filter : Ast.sig_item filter -> unit + val register_str_item_filter : Ast.str_item filter -> unit + val fold_interf_filters : + ('a -> Ast.sig_item filter -> 'a) -> 'a -> 'a + val fold_implem_filters : + ('a -> Ast.str_item filter -> 'a) -> 'a -> 'a + end + type quotation = + { q_name : string; q_loc : string; q_shift : int; q_contents : string + } + module type Quotation = + sig + module Ast : Ast + open Ast + type 'a expand_fun = Loc.t -> string option -> string -> 'a + type expander = + | ExStr of (bool -> string expand_fun) + | ExAst of Ast.expr expand_fun * Ast.patt expand_fun + val add : string -> expander -> unit + val find : string -> expander + val default : string ref + val translate : (string -> string) ref + val expand_expr : + (Loc.t -> string -> Ast.expr) -> Loc.t -> quotation -> Ast.expr + val expand_patt : + (Loc.t -> string -> Ast.patt) -> Loc.t -> quotation -> Ast.patt + val dump_file : (string option) ref + module Error : Error + end + type ('a, 'loc) stream_filter = + ('a * 'loc) Stream.t -> ('a * 'loc) Stream.t + module type Token = + sig + module Loc : Loc + type t + val to_string : t -> string + val print : Format.formatter -> t -> unit + val match_keyword : string -> t -> bool + val extract_string : t -> string + module Filter : + sig + type token_filter = (t, Loc.t) stream_filter + type t + val mk : (string -> bool) -> t + val define_filter : t -> (token_filter -> token_filter) -> unit + val filter : t -> token_filter + val keyword_added : t -> string -> bool -> unit + val keyword_removed : t -> string -> unit + end + module Error : Error + end + type camlp4_token = + | KEYWORD of string | SYMBOL of string | LIDENT of string + | UIDENT of string | ESCAPED_IDENT of string | INT of int * string + | INT32 of int32 * string | INT64 of int64 * string + | NATIVEINT of nativeint * string | FLOAT of float * string + | CHAR of char * string | STRING of string * string | LABEL of string + | OPTLABEL of string | QUOTATION of quotation + | ANTIQUOT of string * string | COMMENT of string | BLANKS of string + | NEWLINE | LINE_DIRECTIVE of int * string option | EOI + module type Camlp4Token = Token with type t = camlp4_token + module type DynLoader = + sig + type t + exception Error of string * string + val mk : ?ocaml_stdlib: bool -> ?camlp4_stdlib: bool -> unit -> t + val fold_load_path : t -> (string -> 'a -> 'a) -> 'a -> 'a + val load : t -> string -> unit + val include_dir : t -> string -> unit + val find_in_path : t -> string -> string + end + module Grammar = + struct + module type Action = + sig + type t + val mk : 'a -> t + val get : t -> 'a + val getf : t -> 'a -> 'b + val getf2 : t -> 'a -> 'b -> 'c + end + type assoc = | NonA | RightA | LeftA + type position = + | First | Last | Before of string | After of string + | Level of string + module type Structure = + sig + module Loc : Loc + module Action : Action + module Token : Token with module Loc = Loc + type gram + type internal_entry + type tree + type token_pattern = ((Token.t -> bool) * string) + type symbol = + | Smeta of string * symbol list * Action.t + | Snterm of internal_entry | Snterml of internal_entry * string + | Slist0 of symbol | Slist0sep of symbol * symbol + | Slist1 of symbol | Slist1sep of symbol * symbol + | Sopt of symbol | Sself | Snext | Stoken of token_pattern + | Skeyword of string | Stree of tree + type production_rule = ((symbol list) * Action.t) + type single_extend_statment = + ((string option) * (assoc option) * (production_rule list)) + type extend_statment = + ((position option) * (single_extend_statment list)) + type delete_statment = symbol list + type ('a, 'b, 'c) fold = + internal_entry -> + symbol list -> ('a Stream.t -> 'b) -> 'a Stream.t -> 'c + type ('a, 'b, 'c) foldsep = + internal_entry -> + symbol list -> + ('a Stream.t -> 'b) -> + ('a Stream.t -> unit) -> 'a Stream.t -> 'c + end + module type Dynamic = + sig + include Structure + val mk : unit -> gram + module Entry : + sig + type 'a t + val mk : gram -> string -> 'a t + val of_parser : + gram -> + string -> ((Token.t * Loc.t) Stream.t -> 'a) -> 'a t + val setup_parser : + 'a t -> ((Token.t * Loc.t) Stream.t -> 'a) -> unit + val name : 'a t -> string + val print : Format.formatter -> 'a t -> unit + val dump : Format.formatter -> 'a t -> unit + val obj : 'a t -> internal_entry + val clear : 'a t -> unit + end + val get_filter : gram -> Token.Filter.t + type 'a not_filtered + val extend : 'a Entry.t -> extend_statment -> unit + val delete_rule : 'a Entry.t -> delete_statment -> unit + val srules : + 'a Entry.t -> ((symbol list) * Action.t) list -> symbol + val sfold0 : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) fold + val sfold1 : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) fold + val sfold0sep : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) foldsep + val lex : + gram -> + Loc.t -> + char Stream.t -> ((Token.t * Loc.t) Stream.t) not_filtered + val lex_string : + gram -> + Loc.t -> string -> ((Token.t * Loc.t) Stream.t) not_filtered + val filter : + gram -> + ((Token.t * Loc.t) Stream.t) not_filtered -> + (Token.t * Loc.t) Stream.t + val parse : 'a Entry.t -> Loc.t -> char Stream.t -> 'a + val parse_string : 'a Entry.t -> Loc.t -> string -> 'a + val parse_tokens_before_filter : + 'a Entry.t -> ((Token.t * Loc.t) Stream.t) not_filtered -> 'a + val parse_tokens_after_filter : + 'a Entry.t -> (Token.t * Loc.t) Stream.t -> 'a + end + module type Static = + sig + include Structure + module Entry : + sig + type 'a t + val mk : string -> 'a t + val of_parser : + string -> ((Token.t * Loc.t) Stream.t -> 'a) -> 'a t + val setup_parser : + 'a t -> ((Token.t * Loc.t) Stream.t -> 'a) -> unit + val name : 'a t -> string + val print : Format.formatter -> 'a t -> unit + val dump : Format.formatter -> 'a t -> unit + val obj : 'a t -> internal_entry + val clear : 'a t -> unit + end + val get_filter : unit -> Token.Filter.t + type 'a not_filtered + val extend : 'a Entry.t -> extend_statment -> unit + val delete_rule : 'a Entry.t -> delete_statment -> unit + val srules : + 'a Entry.t -> ((symbol list) * Action.t) list -> symbol + val sfold0 : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) fold + val sfold1 : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) fold + val sfold0sep : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) foldsep + val lex : + Loc.t -> + char Stream.t -> ((Token.t * Loc.t) Stream.t) not_filtered + val lex_string : + Loc.t -> string -> ((Token.t * Loc.t) Stream.t) not_filtered + val filter : + ((Token.t * Loc.t) Stream.t) not_filtered -> + (Token.t * Loc.t) Stream.t + val parse : 'a Entry.t -> Loc.t -> char Stream.t -> 'a + val parse_string : 'a Entry.t -> Loc.t -> string -> 'a + val parse_tokens_before_filter : + 'a Entry.t -> ((Token.t * Loc.t) Stream.t) not_filtered -> 'a + val parse_tokens_after_filter : + 'a Entry.t -> (Token.t * Loc.t) Stream.t -> 'a + end + end + module type Lexer = + sig + module Loc : Loc + module Token : Token with module Loc = Loc + module Error : Error + val mk : unit -> Loc.t -> char Stream.t -> (Token.t * Loc.t) Stream.t + end + module type Parser = + sig + module Ast : Ast + open Ast + val parse_implem : + ?directive_handler: (str_item -> str_item option) -> + Loc.t -> char Stream.t -> Ast.str_item + val parse_interf : + ?directive_handler: (sig_item -> sig_item option) -> + Loc.t -> char Stream.t -> Ast.sig_item + end + module type Printer = + sig + module Ast : Ast + val print_interf : + ?input_file: string -> ?output_file: string -> Ast.sig_item -> unit + val print_implem : + ?input_file: string -> ?output_file: string -> Ast.str_item -> unit + end + module type Syntax = + sig + module Loc : Loc + module Warning : Warning with module Loc = Loc + module Ast : Ast with module Loc = Loc + module Token : Token with module Loc = Loc + module Gram : Grammar.Static with module Loc = Loc + and module Token = Token + module AntiquotSyntax : AntiquotSyntax with module Ast = Ast + module Quotation : Quotation with module Ast = Ast + module Parser : Parser with module Ast = Ast + module Printer : Printer with module Ast = Ast + end + module type Camlp4Syntax = + sig + module Loc : Loc + module Warning : Warning with module Loc = Loc + module Ast : Camlp4Ast with module Loc = Loc + module Token : Camlp4Token with module Loc = Loc + module Gram : Grammar.Static with module Loc = Loc + and module Token = Token + module AntiquotSyntax : + AntiquotSyntax with module Ast = Camlp4AstToAst(Ast) + module Quotation : Quotation with module Ast = Camlp4AstToAst(Ast) + module Parser : Parser with module Ast = Camlp4AstToAst(Ast) + module Printer : Printer with module Ast = Camlp4AstToAst(Ast) + val interf : ((Ast.sig_item list) * (Loc.t option)) Gram.Entry.t + val implem : ((Ast.str_item list) * (Loc.t option)) Gram.Entry.t + val top_phrase : (Ast.str_item option) Gram.Entry.t + val use_file : ((Ast.str_item list) * (Loc.t option)) Gram.Entry.t + val a_CHAR : string Gram.Entry.t + val a_FLOAT : string Gram.Entry.t + val a_INT : string Gram.Entry.t + val a_INT32 : string Gram.Entry.t + val a_INT64 : string Gram.Entry.t + val a_LABEL : string Gram.Entry.t + val a_LIDENT : string Gram.Entry.t + val a_LIDENT_or_operator : string Gram.Entry.t + val a_NATIVEINT : string Gram.Entry.t + val a_OPTLABEL : string Gram.Entry.t + val a_STRING : string Gram.Entry.t + val a_UIDENT : string Gram.Entry.t + val a_ident : string Gram.Entry.t + val amp_ctyp : Ast.ctyp Gram.Entry.t + val and_ctyp : Ast.ctyp Gram.Entry.t + val match_case : Ast.match_case Gram.Entry.t + val match_case0 : Ast.match_case Gram.Entry.t + val match_case_quot : Ast.match_case Gram.Entry.t + val binding : Ast.binding Gram.Entry.t + val binding_quot : Ast.binding Gram.Entry.t + val class_declaration : Ast.class_expr Gram.Entry.t + val class_description : Ast.class_type Gram.Entry.t + val class_expr : Ast.class_expr Gram.Entry.t + val class_expr_quot : Ast.class_expr Gram.Entry.t + val class_fun_binding : Ast.class_expr Gram.Entry.t + val class_fun_def : Ast.class_expr Gram.Entry.t + val class_info_for_class_expr : Ast.class_expr Gram.Entry.t + val class_info_for_class_type : Ast.class_type Gram.Entry.t + val class_longident : Ast.ident Gram.Entry.t + val class_longident_and_param : Ast.class_expr Gram.Entry.t + val class_name_and_param : (string * Ast.ctyp) Gram.Entry.t + val class_sig_item : Ast.class_sig_item Gram.Entry.t + val class_sig_item_quot : Ast.class_sig_item Gram.Entry.t + val class_signature : Ast.class_sig_item Gram.Entry.t + val class_str_item : Ast.class_str_item Gram.Entry.t + val class_str_item_quot : Ast.class_str_item Gram.Entry.t + val class_structure : Ast.class_str_item Gram.Entry.t + val class_type : Ast.class_type Gram.Entry.t + val class_type_declaration : Ast.class_type Gram.Entry.t + val class_type_longident : Ast.ident Gram.Entry.t + val class_type_longident_and_param : Ast.class_type Gram.Entry.t + val class_type_plus : Ast.class_type Gram.Entry.t + val class_type_quot : Ast.class_type Gram.Entry.t + val comma_ctyp : Ast.ctyp Gram.Entry.t + val comma_expr : Ast.expr Gram.Entry.t + val comma_ipatt : Ast.patt Gram.Entry.t + val comma_patt : Ast.patt Gram.Entry.t + val comma_type_parameter : Ast.ctyp Gram.Entry.t + val constrain : (Ast.ctyp * Ast.ctyp) Gram.Entry.t + val constructor_arg_list : Ast.ctyp Gram.Entry.t + val constructor_declaration : Ast.ctyp Gram.Entry.t + val constructor_declarations : Ast.ctyp Gram.Entry.t + val ctyp : Ast.ctyp Gram.Entry.t + val ctyp_quot : Ast.ctyp Gram.Entry.t + val cvalue_binding : Ast.expr Gram.Entry.t + val direction_flag : Ast.meta_bool Gram.Entry.t + val dummy : unit Gram.Entry.t + val eq_expr : (string -> Ast.patt -> Ast.patt) Gram.Entry.t + val expr : Ast.expr Gram.Entry.t + val expr_eoi : Ast.expr Gram.Entry.t + val expr_quot : Ast.expr Gram.Entry.t + val field : Ast.ctyp Gram.Entry.t + val field_expr : Ast.binding Gram.Entry.t + val fun_binding : Ast.expr Gram.Entry.t + val fun_def : Ast.expr Gram.Entry.t + val ident : Ast.ident Gram.Entry.t + val ident_quot : Ast.ident Gram.Entry.t + val ipatt : Ast.patt Gram.Entry.t + val ipatt_tcon : Ast.patt Gram.Entry.t + val label : string Gram.Entry.t + val label_declaration : Ast.ctyp Gram.Entry.t + val label_expr : Ast.binding Gram.Entry.t + val label_ipatt : Ast.patt Gram.Entry.t + val label_longident : Ast.ident Gram.Entry.t + val label_patt : Ast.patt Gram.Entry.t + val labeled_ipatt : Ast.patt Gram.Entry.t + val let_binding : Ast.binding Gram.Entry.t + val meth_list : Ast.ctyp Gram.Entry.t + val module_binding : Ast.module_binding Gram.Entry.t + val module_binding0 : Ast.module_expr Gram.Entry.t + val module_binding_quot : Ast.module_binding Gram.Entry.t + val module_declaration : Ast.module_type Gram.Entry.t + val module_expr : Ast.module_expr Gram.Entry.t + val module_expr_quot : Ast.module_expr Gram.Entry.t + val module_longident : Ast.ident Gram.Entry.t + val module_longident_with_app : Ast.ident Gram.Entry.t + val module_rec_declaration : Ast.module_binding Gram.Entry.t + val module_type : Ast.module_type Gram.Entry.t + val module_type_quot : Ast.module_type Gram.Entry.t + val more_ctyp : Ast.ctyp Gram.Entry.t + val name_tags : Ast.ctyp Gram.Entry.t + val opt_as_lident : string Gram.Entry.t + val opt_class_self_patt : Ast.patt Gram.Entry.t + val opt_class_self_type : Ast.ctyp Gram.Entry.t + val opt_comma_ctyp : Ast.ctyp Gram.Entry.t + val opt_dot_dot : Ast.meta_bool Gram.Entry.t + val opt_eq_ctyp : (Ast.ctyp list -> Ast.ctyp) Gram.Entry.t + val opt_expr : Ast.expr Gram.Entry.t + val opt_meth_list : Ast.ctyp Gram.Entry.t + val opt_mutable : Ast.meta_bool Gram.Entry.t + val opt_polyt : Ast.ctyp Gram.Entry.t + val opt_private : Ast.meta_bool Gram.Entry.t + val opt_rec : Ast.meta_bool Gram.Entry.t + val opt_virtual : Ast.meta_bool Gram.Entry.t + val opt_when_expr : Ast.expr Gram.Entry.t + val patt : Ast.patt Gram.Entry.t + val patt_as_patt_opt : Ast.patt Gram.Entry.t + val patt_eoi : Ast.patt Gram.Entry.t + val patt_quot : Ast.patt Gram.Entry.t + val patt_tcon : Ast.patt Gram.Entry.t + val phrase : Ast.str_item Gram.Entry.t + val pipe_ctyp : Ast.ctyp Gram.Entry.t + val poly_type : Ast.ctyp Gram.Entry.t + val row_field : Ast.ctyp Gram.Entry.t + val sem_ctyp : Ast.ctyp Gram.Entry.t + val sem_expr : Ast.expr Gram.Entry.t + val sem_expr_for_list : (Ast.expr -> Ast.expr) Gram.Entry.t + val sem_patt : Ast.patt Gram.Entry.t + val sem_patt_for_list : (Ast.patt -> Ast.patt) Gram.Entry.t + val semi : unit Gram.Entry.t + val sequence : Ast.expr Gram.Entry.t + val sig_item : Ast.sig_item Gram.Entry.t + val sig_item_quot : Ast.sig_item Gram.Entry.t + val sig_items : Ast.sig_item Gram.Entry.t + val star_ctyp : Ast.ctyp Gram.Entry.t + val str_item : Ast.str_item Gram.Entry.t + val str_item_quot : Ast.str_item Gram.Entry.t + val str_items : Ast.str_item Gram.Entry.t + val type_constraint : unit Gram.Entry.t + val type_declaration : Ast.ctyp Gram.Entry.t + val type_ident_and_parameters : + (string * (Ast.ctyp list)) Gram.Entry.t + val type_kind : Ast.ctyp Gram.Entry.t + val type_longident : Ast.ident Gram.Entry.t + val type_longident_and_parameters : Ast.ctyp Gram.Entry.t + val type_parameter : Ast.ctyp Gram.Entry.t + val type_parameters : (Ast.ctyp -> Ast.ctyp) Gram.Entry.t + val typevars : Ast.ctyp Gram.Entry.t + val val_longident : Ast.ident Gram.Entry.t + val value_let : unit Gram.Entry.t + val value_val : unit Gram.Entry.t + val with_constr : Ast.with_constr Gram.Entry.t + val with_constr_quot : Ast.with_constr Gram.Entry.t + end + module type SyntaxExtension = + functor (Syn : Syntax) -> Syntax with module Loc = Syn.Loc + and module Warning = Syn.Warning and module Ast = Syn.Ast + and module Token = Syn.Token and module Gram = Syn.Gram + and module AntiquotSyntax = Syn.AntiquotSyntax + and module Quotation = Syn.Quotation + end +module ErrorHandler : + sig + val print : Format.formatter -> exn -> unit + val try_print : Format.formatter -> exn -> unit + val to_string : exn -> string + val try_to_string : exn -> string + val register : (Format.formatter -> exn -> unit) -> unit + module Register (Error : Sig.Error) : sig end + module ObjTools : + sig + val print : Format.formatter -> Obj.t -> unit + val print_desc : Format.formatter -> Obj.t -> unit + val to_string : Obj.t -> string + val desc : Obj.t -> string + end + end = + struct + open Format + module ObjTools = + struct + let desc obj = + if Obj.is_block obj + then "tag = " ^ (string_of_int (Obj.tag obj)) + else "int_val = " ^ (string_of_int (Obj.obj obj)) + let rec to_string r = + if Obj.is_int r + then + (let i : int = Obj.magic r + in (string_of_int i) ^ (" | CstTag" ^ (string_of_int (i + 1)))) + else + (let rec get_fields acc = + function + | 0 -> acc + | n -> let n = n - 1 in get_fields ((Obj.field r n) :: acc) n in + let rec is_list r = + if Obj.is_int r + then r = (Obj.repr 0) + else + (let s = Obj.size r + and t = Obj.tag r + in (t = 0) && ((s = 2) && (is_list (Obj.field r 1)))) in + let rec get_list r = + if Obj.is_int r + then [] + else + (let h = Obj.field r 0 + and t = get_list (Obj.field r 1) + in h :: t) in + let opaque name = "<" ^ (name ^ ">") in + let s = Obj.size r + and t = Obj.tag r + in + match t with + | _ when is_list r -> + let fields = get_list r + in + "[" ^ + ((String.concat "; " (List.map to_string fields)) ^ + "]") + | 0 -> + let fields = get_fields [] s + in + "(" ^ + ((String.concat ", " (List.map to_string fields)) ^ + ")") + | x when x = Obj.lazy_tag -> opaque "lazy" + | x when x = Obj.closure_tag -> opaque "closure" + | x when x = Obj.object_tag -> + let fields = get_fields [] s in + let (_class, id, slots) = + (match fields with + | h :: h' :: t -> (h, h', t) + | _ -> assert false) + in + "Object #" ^ + ((to_string id) ^ + (" (" ^ + ((String.concat ", " (List.map to_string slots)) + ^ ")"))) + | x when x = Obj.infix_tag -> opaque "infix" + | x when x = Obj.forward_tag -> opaque "forward" + | x when x < Obj.no_scan_tag -> + let fields = get_fields [] s + in + "Tag" ^ + ((string_of_int t) ^ + (" (" ^ + ((String.concat ", " (List.map to_string fields)) + ^ ")"))) + | x when x = Obj.string_tag -> + "\"" ^ ((String.escaped (Obj.magic r : string)) ^ "\"") + | x when x = Obj.double_tag -> + string_of_float (Obj.magic r : float) + | x when x = Obj.abstract_tag -> opaque "abstract" + | x when x = Obj.custom_tag -> opaque "custom" + | x when x = Obj.final_tag -> opaque "final" + | _ -> + failwith + ("ObjTools.to_string: unknown tag (" ^ + ((string_of_int t) ^ ")"))) + let print ppf x = fprintf ppf "%s" (to_string x) + let print_desc ppf x = fprintf ppf "%s" (desc x) + end + let default_handler ppf x = + let x = Obj.repr x + in + (fprintf ppf "Camlp4: Uncaught exception: %s" + (Obj.obj (Obj.field (Obj.field x 0) 0) : string); + if (Obj.size x) > 1 + then + (pp_print_string ppf " ("; + for i = 1 to (Obj.size x) - 1 do + if i > 1 then pp_print_string ppf ", " else (); + ObjTools.print ppf (Obj.field x i) + done; + pp_print_char ppf ')') + else (); + fprintf ppf "@.") + let handler = + ref (fun ppf default_handler exn -> default_handler ppf exn) + let register f = + let current_handler = !handler + in + handler := + fun ppf default_handler exn -> + try f ppf exn + with | exn -> current_handler ppf default_handler exn + module Register (Error : Sig.Error) = + struct + let _ = + let current_handler = !handler + in + handler := + fun ppf default_handler -> + function + | Error.E x -> Error.print ppf x + | x -> current_handler ppf default_handler x + end + let gen_print ppf default_handler = + function + | Out_of_memory -> fprintf ppf "Out of memory" + | Assert_failure ((file, line, char)) -> + fprintf ppf "Assertion failed, file %S, line %d, char %d" file line + char + | Match_failure ((file, line, char)) -> + fprintf ppf "Pattern matching failed, file %S, line %d, char %d" + file line char + | Failure str -> fprintf ppf "Failure: %S" str + | Invalid_argument str -> fprintf ppf "Invalid argument: %S" str + | Sys_error str -> fprintf ppf "I/O error: %S" str + | Stream.Failure -> fprintf ppf "Parse failure" + | Stream.Error str -> fprintf ppf "Parse error: %s" str + | x -> !handler ppf default_handler x + let print ppf = gen_print ppf default_handler + let try_print ppf = gen_print ppf (fun _ -> raise) + let to_string exn = + let buf = Buffer.create 128 in + let () = bprintf buf "%a" print exn in Buffer.contents buf + let try_to_string exn = + let buf = Buffer.create 128 in + let () = bprintf buf "%a" try_print exn in Buffer.contents buf + end +module Struct = + struct + module Loc : sig include Sig.Loc end = + struct + open Format + type pos = { line : int; bol : int; off : int } + type t = + { file_name : string; start : pos; stop : pos; ghost : bool + } + let dump_sel f x = + let s = + match x with + | `start -> "`start" + | `stop -> "`stop" + | `both -> "`both" + | _ -> "<not-printable>" + in pp_print_string f s + let dump_pos f x = + fprintf f "@[<hov 2>{ line = %d ;@ bol = %d ;@ off = %d } : pos@]" + x.line x.bol x.off + let dump_long f x = + fprintf f + "@[<hov 2>{ file_name = %s ;@ start = %a (%d-%d);@ stop = %a (%d);@ ghost = %b@ } : Loc.t@]" + x.file_name dump_pos x.start (x.start.off - x.start.bol) + (x.stop.off - x.start.bol) dump_pos x.stop + (x.stop.off - x.stop.bol) x.ghost + let dump f x = + fprintf f "[%S: %d:%d-%d %d:%d%t]" x.file_name x.start.line + (x.start.off - x.start.bol) (x.stop.off - x.start.bol) + x.stop.line (x.stop.off - x.stop.bol) + (fun o -> if x.ghost then fprintf o " (ghost)" else ()) + let start_pos = { line = 1; bol = 0; off = 0; } + let ghost = + { + + file_name = "ghost-location"; + start = start_pos; + stop = start_pos; + ghost = true; + } + let mk file_name = + { + + file_name = file_name; + start = start_pos; + stop = start_pos; + ghost = false; + } + let of_tuple (file_name, start_line, start_bol, start_off, stop_line, + stop_bol, stop_off, ghost) + = + { + + file_name = file_name; + start = { line = start_line; bol = start_bol; off = start_off; }; + stop = { line = stop_line; bol = stop_bol; off = stop_off; }; + ghost = ghost; + } + let to_tuple { + file_name = file_name; + start = + { + line = start_line; + bol = start_bol; + off = start_off + }; + stop = + { line = stop_line; bol = stop_bol; off = stop_off }; + ghost = ghost + } = + (file_name, start_line, start_bol, start_off, stop_line, stop_bol, + stop_off, ghost) + let pos_of_lexing_position p = + let pos = + { + + line = p.Lexing.pos_lnum; + bol = p.Lexing.pos_bol; + off = p.Lexing.pos_cnum; + } + in pos + let pos_to_lexing_position p file_name = + { + + Lexing.pos_fname = file_name; + pos_lnum = p.line; + pos_bol = p.bol; + pos_cnum = p.off; + } + let better_file_name a b = + match (a, b) with + | ("", "") -> a + | ("", x) -> x + | (x, "") -> x + | ("-", x) -> x + | (x, "-") -> x + | (x, _) -> x + let of_lexbuf lb = + let start = Lexing.lexeme_start_p lb + and stop = Lexing.lexeme_end_p lb in + let loc = + { + + file_name = + better_file_name start.Lexing.pos_fname stop.Lexing.pos_fname; + start = pos_of_lexing_position start; + stop = pos_of_lexing_position stop; + ghost = false; + } + in loc + let of_lexing_position pos = + let loc = + { + + file_name = pos.Lexing.pos_fname; + start = pos_of_lexing_position pos; + stop = pos_of_lexing_position pos; + ghost = false; + } + in loc + let to_ocaml_location x = + { + + Location.loc_start = pos_to_lexing_position x.start x.file_name; + loc_end = pos_to_lexing_position x.stop x.file_name; + loc_ghost = x.ghost; + } + let of_ocaml_location x = + let (a, b) = ((x.Location.loc_start), (x.Location.loc_end)) in + let res = + { + + file_name = + better_file_name a.Lexing.pos_fname b.Lexing.pos_fname; + start = pos_of_lexing_position a; + stop = pos_of_lexing_position b; + ghost = x.Location.loc_ghost; + } + in res + let start_pos x = pos_to_lexing_position x.start x.file_name + let stop_pos x = pos_to_lexing_position x.stop x.file_name + let merge a b = + if a == b + then a + else + (let r = + match ((a.ghost), (b.ghost)) with + | (false, false) -> { (a) with stop = b.stop; } + | (true, true) -> { (a) with stop = b.stop; } + | (true, _) -> { (a) with stop = b.stop; } + | (_, true) -> { (b) with start = a.start; } + in r) + let join x = { (x) with stop = x.start; } + let map f start_stop_both x = + match start_stop_both with + | `start -> { (x) with start = f x.start; } + | `stop -> { (x) with stop = f x.stop; } + | `both -> { (x) with start = f x.start; stop = f x.stop; } + let move_pos chars x = { (x) with off = x.off + chars; } + let move s chars x = map (move_pos chars) s x + let move_line lines x = + let move_line_pos x = + { (x) with line = x.line + lines; bol = x.off; } + in map move_line_pos `both x + let shift width x = + { (x) with start = x.stop; stop = move_pos width x.stop; } + let file_name x = x.file_name + let start_line x = x.start.line + let stop_line x = x.stop.line + let start_bol x = x.start.bol + let stop_bol x = x.stop.bol + let start_off x = x.start.off + let stop_off x = x.stop.off + let is_ghost x = x.ghost + let set_file_name s x = { (x) with file_name = s; } + let ghostify x = { (x) with ghost = true; } + let make_absolute x = + let pwd = Sys.getcwd () + in + if Filename.is_relative x.file_name + then { (x) with file_name = Filename.concat pwd x.file_name; } + else x + let strictly_before x y = + let b = (x.stop.off < y.start.off) && (x.file_name = y.file_name) + in b + let to_string x = + let (a, b) = ((x.start), (x.stop)) in + let res = + sprintf "File \"%s\", line %d, characters %d-%d" x.file_name + a.line (a.off - a.bol) (b.off - a.bol) + in + if x.start.line <> x.stop.line + then + sprintf "%s (end at line %d, character %d)" res x.stop.line + (b.off - b.bol) + else res + let print out x = pp_print_string out (to_string x) + let check x msg = + if + ((start_line x) > (stop_line x)) || + (((start_bol x) > (stop_bol x)) || + (((start_off x) > (stop_off x)) || + (((start_line x) < 0) || + (((stop_line x) < 0) || + (((start_bol x) < 0) || + (((stop_bol x) < 0) || + (((start_off x) < 0) || ((stop_off x) < 0)))))))) + then + (eprintf "*** Warning: (%s) strange positions ***\n%a@\n" msg + print x; + false) + else true + exception Exc_located of t * exn + let _ = + ErrorHandler.register + (fun ppf -> + function + | Exc_located (loc, exn) -> + fprintf ppf "%a:@\n%a" print loc ErrorHandler.print exn + | exn -> raise exn) + let name = ref "_loc" + let raise loc exc = + match exc with + | Exc_located (_, _) -> raise exc + | _ -> raise (Exc_located (loc, exc)) + end + module Warning = + struct + module Make (Loc : Sig.Loc) : Sig.Warning with module Loc = Loc = + struct + module Loc = Loc + open Format + type t = Loc.t -> string -> unit + let default loc txt = eprintf "<W> %a: %s@." Loc.print loc txt + let current = ref default + let print loc txt = !current loc txt + end + end + module Token : + sig + module Make (Loc : Sig.Loc) : Sig.Camlp4Token with module Loc = Loc + module Eval : + sig + val char : string -> char + val string : ?strict: unit -> string -> string + end + end = + struct + open Format + module Make (Loc : Sig.Loc) : Sig.Camlp4Token with module Loc = Loc = + struct + module Loc = Loc + open Sig + type t = camlp4_token + type token = t + let to_string = + function + | KEYWORD s -> sprintf "KEYWORD %S" s + | SYMBOL s -> sprintf "SYMBOL %S" s + | LIDENT s -> sprintf "LIDENT %S" s + | UIDENT s -> sprintf "UIDENT %S" s + | INT (_, s) -> sprintf "INT %s" s + | INT32 (_, s) -> sprintf "INT32 %sd" s + | INT64 (_, s) -> sprintf "INT64 %sd" s + | NATIVEINT (_, s) -> sprintf "NATIVEINT %sd" s + | FLOAT (_, s) -> sprintf "FLOAT %s" s + | CHAR (_, s) -> sprintf "CHAR '%s'" s + | STRING (_, s) -> sprintf "STRING \"%s\"" s + | LABEL s -> sprintf "LABEL %S" s + | OPTLABEL s -> sprintf "OPTLABEL %S" s + | ANTIQUOT (n, s) -> sprintf "ANTIQUOT %s: %S" n s + | QUOTATION x -> + sprintf + "QUOTATION { q_name=%S; q_loc=%S; q_shift=%d; q_contents=%S }" + x.q_name x.q_loc x.q_shift x.q_contents + | COMMENT s -> sprintf "COMMENT %S" s + | BLANKS s -> sprintf "BLANKS %S" s + | NEWLINE -> sprintf "NEWLINE" + | EOI -> sprintf "EOI" + | ESCAPED_IDENT s -> sprintf "ESCAPED_IDENT %S" s + | LINE_DIRECTIVE (i, None) -> sprintf "LINE_DIRECTIVE %d" i + | LINE_DIRECTIVE (i, (Some s)) -> + sprintf "LINE_DIRECTIVE %d %S" i s + let print ppf x = pp_print_string ppf (to_string x) + let match_keyword kwd = + function | KEYWORD kwd' when kwd = kwd' -> true | _ -> false + let extract_string = + function + | KEYWORD s | SYMBOL s | LIDENT s | UIDENT s | INT (_, s) | + INT32 (_, s) | INT64 (_, s) | NATIVEINT (_, s) | + FLOAT (_, s) | CHAR (_, s) | STRING (_, s) | LABEL s | + OPTLABEL s | COMMENT s | BLANKS s | ESCAPED_IDENT s -> s + | tok -> + invalid_arg + ("Cannot extract a string from a this token: " ^ + (to_string tok)) + module Error = + struct + type t = + | Illegal_token of string | Keyword_as_label of string + | Illegal_token_pattern of string * string + | Illegal_constructor of string + exception E of t + let print ppf = + function + | Illegal_token s -> fprintf ppf "Illegal token (%s)" s + | Keyword_as_label kwd -> + fprintf ppf + "`%s' is a keyword, it cannot be used as label name" + kwd + | Illegal_token_pattern (p_con, p_prm) -> + fprintf ppf "Illegal token pattern: %s %S" p_con p_prm + | Illegal_constructor con -> + fprintf ppf "Illegal constructor %S" con + let to_string x = + let b = Buffer.create 50 in + let () = bprintf b "%a" print x in Buffer.contents b + end + let _ = let module M = ErrorHandler.Register(Error) in () + module Filter = + struct + type token_filter = (t, Loc.t) stream_filter + type t = + { is_kwd : string -> bool; mutable filter : token_filter + } + let err error loc = + raise (Loc.Exc_located (loc, Error.E error)) + let keyword_conversion tok is_kwd = + match tok with + | SYMBOL s | LIDENT s | UIDENT s when is_kwd s -> KEYWORD s + | ESCAPED_IDENT s -> LIDENT s + | _ -> tok + let check_keyword_as_label tok loc is_kwd = + let s = + match tok with | LABEL s -> s | OPTLABEL s -> s | _ -> "" + in + if (s <> "") && (is_kwd s) + then err (Error.Keyword_as_label s) loc + else () + let check_unknown_keywords tok loc = + match tok with + | SYMBOL s -> err (Error.Illegal_token s) loc + | _ -> () + let error_no_respect_rules p_con p_prm = + raise + (Error.E (Error.Illegal_token_pattern (p_con, p_prm))) + let check_keyword _ = true + let error_on_unknown_keywords = ref false + let rec ignore_layout (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some + (((COMMENT _ | BLANKS _ | NEWLINE | + LINE_DIRECTIVE (_, _)), + _)) + -> (Stream.junk __strm; ignore_layout __strm) + | Some x -> + (Stream.junk __strm; + let s = __strm + in + Stream.icons x + (Stream.slazy (fun _ -> ignore_layout s))) + | _ -> Stream.sempty + let mk is_kwd = { is_kwd = is_kwd; filter = ignore_layout; } + let filter x = + let f tok loc = + let tok = keyword_conversion tok x.is_kwd + in + (check_keyword_as_label tok loc x.is_kwd; + if !error_on_unknown_keywords + then check_unknown_keywords tok loc + else (); + (tok, loc)) in + let rec filter (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some ((tok, loc)) -> + (Stream.junk __strm; + let s = __strm + in + Stream.lcons (fun _ -> f tok loc) + (Stream.slazy (fun _ -> filter s))) + | _ -> Stream.sempty in + let rec tracer (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some (((_tok, _loc) as x)) -> + (Stream.junk __strm; + let xs = __strm + in + Stream.icons x (Stream.slazy (fun _ -> tracer xs))) + | _ -> Stream.sempty + in fun strm -> tracer (x.filter (filter strm)) + let define_filter x f = x.filter <- f x.filter + let keyword_added _ _ _ = () + let keyword_removed _ _ = () + end + end + module Eval = + struct + let valch x = (Char.code x) - (Char.code '0') + let valch_hex x = + let d = Char.code x + in + if d >= 97 + then d - 87 + else if d >= 65 then d - 55 else d - 48 + let rec skip_indent (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some (' ' | '\t') -> (Stream.junk __strm; skip_indent __strm) + | _ -> () + let skip_opt_linefeed (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some '\010' -> (Stream.junk __strm; ()) + | _ -> () + let rec backslash (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some '\010' -> (Stream.junk __strm; '\010') + | Some '\013' -> (Stream.junk __strm; '\013') + | Some 'n' -> (Stream.junk __strm; '\n') + | Some 'r' -> (Stream.junk __strm; '\r') + | Some 't' -> (Stream.junk __strm; '\t') + | Some 'b' -> (Stream.junk __strm; '\b') + | Some '\\' -> (Stream.junk __strm; '\\') + | Some '"' -> (Stream.junk __strm; '"') + | Some '\'' -> (Stream.junk __strm; '\'') + | Some ' ' -> (Stream.junk __strm; ' ') + | Some (('0' .. '9' as c1)) -> + (Stream.junk __strm; + (match Stream.peek __strm with + | Some (('0' .. '9' as c2)) -> + (Stream.junk __strm; + (match Stream.peek __strm with + | Some (('0' .. '9' as c3)) -> + (Stream.junk __strm; + Char.chr + (((100 * (valch c1)) + (10 * (valch c2))) + + (valch c3))) + | _ -> raise (Stream.Error ""))) + | _ -> raise (Stream.Error ""))) + | Some 'x' -> + (Stream.junk __strm; + (match Stream.peek __strm with + | Some (('0' .. '9' | 'a' .. 'f' | 'A' .. 'F' as c1)) -> + (Stream.junk __strm; + (match Stream.peek __strm with + | Some + (('0' .. '9' | 'a' .. 'f' | 'A' .. 'F' as c2)) + -> + (Stream.junk __strm; + Char.chr + ((16 * (valch_hex c1)) + (valch_hex c2))) + | _ -> raise (Stream.Error ""))) + | _ -> raise (Stream.Error ""))) + | _ -> raise Stream.Failure + let rec backslash_in_string strict store (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some '\010' -> (Stream.junk __strm; skip_indent __strm) + | Some '\013' -> + (Stream.junk __strm; + let s = __strm in (skip_opt_linefeed s; skip_indent s)) + | _ -> + (match try Some (backslash __strm) + with | Stream.Failure -> None + with + | Some x -> store x + | _ -> + (match Stream.peek __strm with + | Some c when not strict -> + (Stream.junk __strm; store '\\'; store c) + | _ -> failwith "invalid string token")) + let char s = + if (String.length s) = 1 + then s.[0] + else + if (String.length s) = 0 + then failwith "invalid char token" + else + (let (__strm : _ Stream.t) = Stream.of_string s + in + match Stream.peek __strm with + | Some '\\' -> + (Stream.junk __strm; + (try backslash __strm + with | Stream.Failure -> raise (Stream.Error ""))) + | _ -> failwith "invalid char token") + let string ?strict s = + let buf = Buffer.create 23 in + let store = Buffer.add_char buf in + let rec parse (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some '\\' -> + (Stream.junk __strm; + let _ = + (try backslash_in_string (strict <> None) store __strm + with | Stream.Failure -> raise (Stream.Error "")) + in parse __strm) + | Some c -> + (Stream.junk __strm; + let s = __strm in (store c; parse s)) + | _ -> Buffer.contents buf + in parse (Stream.of_string s) + end + end + module Lexer = + struct + module TokenEval = Token.Eval + module Make (Token : Sig.Camlp4Token) = + struct + module Loc = Token.Loc + module Token = Token + open Lexing + open Sig + module Error = + struct + type t = + | Illegal_character of char | Illegal_escape of string + | Unterminated_comment | Unterminated_string + | Unterminated_quotation | Unterminated_antiquot + | Unterminated_string_in_comment | Comment_start + | Comment_not_end | Literal_overflow of string + exception E of t + open Format + let print ppf = + function + | Illegal_character c -> + fprintf ppf "Illegal character (%s)" (Char.escaped c) + | Illegal_escape s -> + fprintf ppf + "Illegal backslash escape in string or character (%s)" + s + | Unterminated_comment -> + fprintf ppf "Comment not terminated" + | Unterminated_string -> + fprintf ppf "String literal not terminated" + | Unterminated_string_in_comment -> + fprintf ppf + "This comment contains an unterminated string literal" + | Unterminated_quotation -> + fprintf ppf "Quotation not terminated" + | Unterminated_antiquot -> + fprintf ppf "Antiquotation not terminated" + | Literal_overflow ty -> + fprintf ppf + "Integer literal exceeds the range of representable integers of type %s" + ty + | Comment_start -> + fprintf ppf "this is the start of a comment" + | Comment_not_end -> + fprintf ppf "this is not the end of a comment" + let to_string x = + let b = Buffer.create 50 in + let () = bprintf b "%a" print x in Buffer.contents b + end + let _ = let module M = ErrorHandler.Register(Error) in () + open Error + type context = + { loc : Loc.t; in_comment : bool; quotations : bool; + lexbuf : lexbuf; buffer : Buffer.t + } + let default_context lb = + { + + loc = Loc.ghost; + in_comment = false; + quotations = true; + lexbuf = lb; + buffer = Buffer.create 256; + } + let store c = Buffer.add_string c.buffer (Lexing.lexeme c.lexbuf) + let istore_char c i = + Buffer.add_char c.buffer (Lexing.lexeme_char c.lexbuf i) + let buff_contents c = + let contents = Buffer.contents c.buffer + in (Buffer.reset c.buffer; contents) + let loc c = Loc.merge c.loc (Loc.of_lexbuf c.lexbuf) + let quotations c = c.quotations + let is_in_comment c = c.in_comment + let in_comment c = { (c) with in_comment = true; } + let set_start_p c = c.lexbuf.lex_start_p <- Loc.start_pos c.loc + let move_start_p shift c = + let p = c.lexbuf.lex_start_p + in + c.lexbuf.lex_start_p <- + { (p) with pos_cnum = p.pos_cnum + shift; } + let with_curr_loc f c = + f { (c) with loc = Loc.of_lexbuf c.lexbuf; } c.lexbuf + let parse_nested f c = + (with_curr_loc f c; set_start_p c; buff_contents c) + let shift n c = { (c) with loc = Loc.move `both n c.loc; } + let store_parse f c = (store c; f c c.lexbuf) + let parse f c = f c c.lexbuf + let mk_quotation quotation c name loc shift = + let s = parse_nested quotation c in + let contents = String.sub s 0 ((String.length s) - 2) + in + QUOTATION + { + + q_name = name; + q_loc = loc; + q_shift = shift; + q_contents = contents; + } + let update_loc c file line absolute chars = + let lexbuf = c.lexbuf in + let pos = lexbuf.lex_curr_p in + let new_file = + match file with | None -> pos.pos_fname | Some s -> s + in + lexbuf.lex_curr_p <- + { + (pos) + with + + pos_fname = new_file; + pos_lnum = if absolute then line else pos.pos_lnum + line; + pos_bol = pos.pos_cnum - chars; + } + let err error loc = raise (Loc.Exc_located (loc, Error.E error)) + let warn error loc = + Format.eprintf "Warning: %a: %a@." Loc.print loc Error.print + error + let __ocaml_lex_tables = + { + + Lexing.lex_base = + "\000\000\227\255\228\255\001\001\001\001\231\255\232\255\160\001\ + \198\001\067\000\091\000\069\000\071\000\084\000\122\000\235\001\ + \014\002\092\000\102\001\244\255\035\002\068\002\141\002\093\003\ + \060\004\152\004\126\000\001\000\255\255\104\005\253\255\056\006\ + \252\255\245\255\246\255\247\255\023\001\001\001\088\000\091\000\ + \216\002\168\003\179\005\179\001\088\004\132\000\024\007\108\000\ + \151\000\109\000\243\255\242\255\241\255\012\005\033\001\111\000\ + \239\002\193\005\111\000\239\255\238\255\024\007\063\007\109\007\ + \148\007\183\007\174\006\015\003\004\000\233\255\093\001\199\001\ + \151\002\094\001\005\000\233\255\054\008\246\008\006\000\117\004\ + \251\255\208\009\095\000\115\000\115\000\254\255\016\010\207\010\ + \159\011\111\012\079\013\121\000\152\000\124\000\126\000\249\255\ + \248\255\144\006\197\003\127\000\060\004\128\000\200\007\129\000\ + \008\003\007\000\106\013\250\255\054\008\169\004\089\001\082\001\ + \179\004\198\008\054\008\172\013\139\014\169\014\136\015\103\016\ + \135\016\199\016\151\017\254\255\204\001\008\000\107\000\053\001\ + \215\017\150\018\102\019\054\020\018\021\062\001\236\021\197\022\ + \064\001\149\023\248\003\155\001\009\000\213\023\148\024\100\025\ + \052\026"; + Lexing.lex_backtrk = + "\255\255\255\255\255\255\028\000\025\000\255\255\255\255\025\000\ + \025\000\023\000\023\000\023\000\023\000\023\000\023\000\025\000\ + \025\000\023\000\023\000\255\255\006\000\006\000\005\000\004\000\ + \025\000\025\000\001\000\000\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\007\000\255\255\255\255\ + \255\255\006\000\006\000\006\000\007\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\014\000\014\000\014\000\ + \255\255\255\255\015\000\255\255\255\255\021\000\020\000\018\000\ + \025\000\019\000\255\255\255\255\022\000\255\255\255\255\255\255\ + \255\255\255\255\022\000\255\255\026\000\255\255\013\000\014\000\ + \255\255\003\000\014\000\014\000\014\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\005\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\006\000\008\000\255\255\005\000\005\000\001\000\001\000\ + \255\255\255\255\000\000\001\000\001\000\255\255\002\000\002\000\ + \255\255\255\255\255\255\255\255\255\255\003\000\004\000\004\000\ + \255\255\255\255\255\255\255\255\255\255\002\000\002\000\002\000\ + \255\255\255\255\255\255\004\000\002\000\255\255\255\255\255\255\ + \255\255"; + Lexing.lex_default = + "\001\000\000\000\000\000\076\000\255\255\000\000\000\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\047\000\000\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\000\000\255\255\000\000\255\255\ + \000\000\000\000\000\000\000\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\052\000\255\255\ + \255\255\255\255\000\000\000\000\000\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\000\000\000\000\255\255\255\255\255\255\ + \255\255\255\255\070\000\255\255\255\255\000\000\070\000\071\000\ + \070\000\073\000\255\255\000\000\076\000\052\000\255\255\091\000\ + \000\000\255\255\255\255\255\255\255\255\000\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\000\000\ + \000\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \035\000\255\255\107\000\000\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\000\000\080\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\030\000\255\255\255\255\255\255\ + \255\255\255\255\080\000\255\255\255\255\255\255\255\255\255\255\ + \255\255"; + Lexing.lex_trans = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\026\000\028\000\028\000\026\000\027\000\069\000\075\000\ + \051\000\095\000\032\000\030\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \026\000\004\000\019\000\014\000\005\000\004\000\004\000\018\000\ + \017\000\006\000\016\000\004\000\006\000\004\000\013\000\004\000\ + \021\000\020\000\020\000\020\000\020\000\020\000\020\000\020\000\ + \020\000\020\000\012\000\011\000\015\000\004\000\007\000\024\000\ + \004\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\010\000\003\000\006\000\004\000\023\000\ + \006\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\009\000\008\000\006\000\025\000\006\000\ + \006\000\006\000\006\000\067\000\006\000\006\000\058\000\026\000\ + \043\000\043\000\026\000\042\000\042\000\042\000\042\000\042\000\ + \042\000\042\000\042\000\051\000\050\000\006\000\051\000\006\000\ + \059\000\087\000\067\000\030\000\085\000\028\000\026\000\086\000\ + \035\000\049\000\093\000\096\000\006\000\095\000\034\000\033\000\ + \019\000\085\000\066\000\066\000\066\000\066\000\066\000\066\000\ + \066\000\066\000\066\000\066\000\044\000\044\000\044\000\044\000\ + \044\000\044\000\044\000\044\000\044\000\044\000\050\000\096\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\006\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\000\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \002\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\004\000\255\255\255\255\004\000\004\000\004\000\ + \000\000\255\255\255\255\004\000\004\000\255\255\004\000\004\000\ + \004\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\004\000\255\255\004\000\004\000\004\000\ + \004\000\004\000\045\000\000\000\045\000\000\000\036\000\044\000\ + \044\000\044\000\044\000\044\000\044\000\044\000\044\000\044\000\ + \044\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\056\000\056\000\111\000\255\255\255\255\255\255\004\000\ + \037\000\255\255\111\000\111\000\000\000\000\000\036\000\069\000\ + \075\000\000\000\068\000\074\000\136\000\000\000\136\000\129\000\ + \049\000\028\000\111\000\048\000\000\000\128\000\000\000\000\000\ + \085\000\111\000\085\000\000\000\255\255\004\000\255\255\004\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\004\000\046\000\000\000\004\000\004\000\004\000\000\000\ + \000\000\000\000\004\000\004\000\000\000\004\000\004\000\004\000\ + \000\000\069\000\000\000\000\000\068\000\142\000\032\000\032\000\ + \255\255\125\000\004\000\141\000\004\000\004\000\004\000\004\000\ + \004\000\000\000\000\000\043\000\043\000\000\000\000\000\004\000\ + \000\000\073\000\004\000\004\000\004\000\000\000\000\000\000\000\ + \004\000\004\000\000\000\004\000\004\000\004\000\000\000\000\000\ + \255\255\000\000\000\000\000\000\000\000\006\000\004\000\034\000\ + \004\000\255\255\004\000\004\000\004\000\004\000\004\000\000\000\ + \127\000\000\000\126\000\000\000\004\000\000\000\000\000\004\000\ + \004\000\004\000\043\000\000\000\000\000\004\000\004\000\000\000\ + \004\000\004\000\004\000\000\000\004\000\006\000\004\000\035\000\ + \000\000\033\000\000\000\006\000\004\000\061\000\000\000\063\000\ + \004\000\004\000\004\000\062\000\000\000\000\000\000\000\004\000\ + \000\000\000\000\004\000\004\000\004\000\000\000\000\000\060\000\ + \004\000\004\000\000\000\004\000\004\000\004\000\000\000\000\000\ + \000\000\000\000\004\000\000\000\004\000\000\000\000\000\000\000\ + \004\000\004\000\004\000\004\000\004\000\004\000\004\000\000\000\ + \000\000\037\000\000\000\020\000\020\000\020\000\020\000\020\000\ + \020\000\020\000\020\000\020\000\020\000\255\255\255\255\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\255\255\004\000\ + \036\000\004\000\000\000\000\000\004\000\000\000\000\000\034\000\ + \000\000\000\000\037\000\000\000\020\000\020\000\020\000\020\000\ + \020\000\020\000\020\000\020\000\020\000\020\000\000\000\000\000\ + \000\000\000\000\020\000\000\000\000\000\000\000\038\000\000\000\ + \036\000\036\000\004\000\000\000\004\000\000\000\000\000\035\000\ + \034\000\033\000\000\000\039\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\040\000\000\000\000\000\000\000\ + \072\000\069\000\000\000\020\000\068\000\000\000\038\000\000\000\ + \000\000\036\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \035\000\000\000\033\000\039\000\022\000\000\000\000\000\072\000\ + \000\000\071\000\000\000\000\000\040\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\255\255\ + \000\000\000\000\000\000\000\000\030\000\000\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \000\000\000\000\000\000\000\000\022\000\000\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \041\000\041\000\041\000\041\000\041\000\041\000\041\000\041\000\ + \041\000\041\000\095\000\000\000\000\000\105\000\000\000\000\000\ + \067\000\041\000\041\000\041\000\041\000\041\000\041\000\047\000\ + \047\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\000\000\028\000\000\000\000\000\000\000\000\000\067\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\041\000\041\000\041\000\041\000\041\000\041\000\066\000\ + \066\000\066\000\066\000\066\000\066\000\066\000\066\000\066\000\ + \066\000\000\000\000\000\000\000\000\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\106\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\023\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\255\255\ + \000\000\000\000\000\000\000\000\000\000\000\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \000\000\000\000\000\000\000\000\023\000\000\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \041\000\041\000\041\000\041\000\041\000\041\000\041\000\041\000\ + \041\000\041\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\041\000\041\000\041\000\041\000\041\000\041\000\000\000\ + \000\000\000\000\000\000\000\000\034\000\100\000\100\000\100\000\ + \100\000\100\000\100\000\100\000\100\000\100\000\100\000\000\000\ + \000\000\000\000\030\000\000\000\000\000\140\000\000\000\041\000\ + \096\000\041\000\041\000\041\000\041\000\041\000\041\000\000\000\ + \000\000\000\000\000\000\000\000\035\000\000\000\033\000\000\000\ + \000\000\000\000\000\000\000\000\028\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\139\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\000\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\004\000\000\000\000\000\ + \004\000\004\000\004\000\000\000\000\000\000\000\004\000\004\000\ + \000\000\004\000\004\000\004\000\101\000\101\000\101\000\101\000\ + \101\000\101\000\101\000\101\000\101\000\101\000\004\000\000\000\ + \004\000\004\000\004\000\004\000\004\000\000\000\000\000\093\000\ + \000\000\000\000\092\000\000\000\000\000\000\000\000\000\000\000\ + \044\000\044\000\044\000\044\000\044\000\044\000\044\000\044\000\ + \044\000\044\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\004\000\031\000\094\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\044\000\ + \004\000\004\000\004\000\000\000\004\000\004\000\004\000\000\000\ + \000\000\000\000\004\000\004\000\000\000\004\000\004\000\004\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\090\000\004\000\000\000\004\000\004\000\004\000\004\000\ + \004\000\112\000\112\000\112\000\112\000\112\000\112\000\112\000\ + \112\000\112\000\112\000\032\000\032\000\032\000\032\000\032\000\ + \032\000\032\000\032\000\032\000\032\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\004\000\029\000\ + \085\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\000\000\004\000\000\000\004\000\000\000\ + \000\000\000\000\000\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\000\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\057\000\057\000\057\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\000\000\000\000\255\255\000\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\030\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\000\000\000\000\000\000\000\000\029\000\ + \000\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\042\000\042\000\042\000\042\000\042\000\ + \042\000\042\000\042\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\047\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \047\000\047\000\047\000\000\000\000\000\000\000\000\000\034\000\ + \000\000\000\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\042\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\035\000\ + \000\000\033\000\047\000\047\000\047\000\047\000\047\000\047\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\000\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\031\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\032\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\000\000\000\000\000\000\000\000\031\000\ + \000\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\000\000\000\000\000\000\000\000\072\000\ + \069\000\000\000\000\000\068\000\000\000\000\000\000\000\000\000\ + \102\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ + \102\000\102\000\000\000\000\000\000\000\000\000\072\000\000\000\ + \071\000\102\000\102\000\102\000\102\000\102\000\102\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\066\000\066\000\ + \066\000\066\000\066\000\066\000\066\000\066\000\066\000\066\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\102\000\102\000\102\000\102\000\102\000\102\000\000\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\000\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\000\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \055\000\004\000\055\000\000\000\004\000\004\000\004\000\055\000\ + \000\000\000\000\004\000\004\000\000\000\004\000\004\000\004\000\ + \054\000\054\000\054\000\054\000\054\000\054\000\054\000\054\000\ + \054\000\054\000\004\000\000\000\004\000\004\000\004\000\004\000\ + \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \004\000\000\000\000\000\004\000\004\000\004\000\000\000\000\000\ + \000\000\004\000\004\000\000\000\004\000\004\000\004\000\000\000\ + \000\000\000\000\000\000\000\000\055\000\000\000\004\000\000\000\ + \000\000\004\000\055\000\004\000\004\000\004\000\004\000\004\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\055\000\000\000\ + \000\000\000\000\055\000\000\000\055\000\000\000\004\000\000\000\ + \053\000\004\000\004\000\004\000\004\000\000\000\004\000\004\000\ + \004\000\000\000\004\000\004\000\004\000\004\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\ + \000\000\004\000\004\000\064\000\004\000\004\000\255\255\000\000\ + \000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\ + \004\000\004\000\004\000\004\000\000\000\004\000\004\000\004\000\ + \000\000\004\000\004\000\004\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\004\000\000\000\000\000\004\000\000\000\ + \004\000\004\000\065\000\004\000\004\000\000\000\000\000\000\000\ + \004\000\000\000\000\000\004\000\004\000\004\000\000\000\000\000\ + \000\000\004\000\004\000\000\000\004\000\004\000\004\000\000\000\ + \000\000\004\000\000\000\004\000\000\000\000\000\000\000\000\000\ + \000\000\004\000\004\000\004\000\004\000\004\000\004\000\004\000\ + \103\000\103\000\103\000\103\000\103\000\103\000\103\000\103\000\ + \103\000\103\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\103\000\103\000\103\000\103\000\103\000\103\000\000\000\ + \004\000\000\000\004\000\000\000\000\000\004\000\000\000\000\000\ + \255\255\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\103\000\103\000\103\000\103\000\103\000\103\000\000\000\ + \000\000\000\000\000\000\004\000\000\000\004\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\114\000\ + \255\255\255\255\114\000\114\000\114\000\000\000\255\255\255\255\ + \114\000\114\000\255\255\114\000\114\000\114\000\113\000\113\000\ + \113\000\113\000\113\000\113\000\113\000\113\000\113\000\113\000\ + \114\000\255\255\114\000\114\000\114\000\114\000\114\000\113\000\ + \113\000\113\000\113\000\113\000\113\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\255\255\255\255\255\255\114\000\000\000\255\255\113\000\ + \113\000\113\000\113\000\113\000\113\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\255\255\114\000\255\255\114\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\080\000\080\000\ + \080\000\080\000\080\000\080\000\080\000\080\000\080\000\080\000\ + \051\000\000\000\000\000\078\000\000\000\000\000\000\000\080\000\ + \080\000\080\000\080\000\080\000\080\000\255\255\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \080\000\000\000\000\000\000\000\000\000\079\000\084\000\000\000\ + \083\000\000\000\000\000\000\000\000\000\000\000\000\000\080\000\ + \080\000\080\000\080\000\080\000\080\000\255\255\000\000\000\000\ + \000\000\000\000\082\000\000\000\000\000\000\000\255\255\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\000\000\000\000\000\000\000\000\081\000\000\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\000\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\000\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\050\000\081\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\000\000\000\000\000\000\000\000\081\000\ + \000\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\000\000\000\000\000\000\000\000\089\000\ + \000\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\000\000\000\000\000\000\000\000\000\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\000\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\000\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\000\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\000\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\000\000\000\000\000\000\000\000\088\000\000\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\000\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\000\000\000\000\030\000\000\000\000\000\000\000\086\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\000\000\000\000\000\000\000\000\088\000\000\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\000\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\089\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\000\000\000\000\030\000\000\000\000\000\000\000\000\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\000\000\000\000\000\000\000\000\089\000\000\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\000\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\000\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\099\000\ + \000\000\099\000\000\000\000\000\111\000\000\000\099\000\110\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\098\000\ + \098\000\098\000\098\000\098\000\098\000\098\000\098\000\098\000\ + \098\000\000\000\030\000\000\000\030\000\000\000\000\000\000\000\ + \000\000\030\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\109\000\109\000\109\000\109\000\109\000\109\000\ + \109\000\109\000\109\000\109\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\099\000\000\000\000\000\000\000\000\000\ + \000\000\099\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\099\000\000\000\000\000\ + \000\000\099\000\000\000\099\000\000\000\000\000\030\000\097\000\ + \000\000\000\000\000\000\000\000\030\000\116\000\000\000\000\000\ + \116\000\116\000\116\000\000\000\000\000\000\000\116\000\116\000\ + \030\000\116\000\116\000\116\000\030\000\000\000\030\000\000\000\ + \000\000\000\000\108\000\000\000\000\000\000\000\116\000\000\000\ + \116\000\116\000\116\000\116\000\116\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\000\000\ + \000\000\000\000\116\000\117\000\000\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\000\000\ + \116\000\000\000\116\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\255\255\000\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\000\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\000\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\116\000\000\000\000\000\116\000\ + \116\000\116\000\000\000\000\000\000\000\116\000\116\000\000\000\ + \116\000\116\000\116\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\116\000\000\000\116\000\ + \116\000\116\000\116\000\116\000\000\000\000\000\000\000\000\000\ + \117\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\000\000\000\000\028\000\000\000\000\000\ + \000\000\116\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\000\000\000\000\000\000\116\000\ + \117\000\116\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \000\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \000\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\119\000\000\000\000\000\119\000\119\000\119\000\000\000\ + \000\000\000\000\119\000\119\000\000\000\119\000\119\000\119\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\119\000\000\000\119\000\119\000\119\000\119\000\ + \119\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\000\000\000\000\000\000\119\000\120\000\ + \000\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\000\000\119\000\000\000\119\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\000\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\000\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \119\000\000\000\000\000\119\000\119\000\119\000\000\000\000\000\ + \000\000\119\000\119\000\000\000\119\000\119\000\119\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\119\000\000\000\119\000\119\000\119\000\119\000\119\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\120\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\000\000\000\000\028\000\000\000\119\000\000\000\121\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\000\000\119\000\000\000\119\000\120\000\000\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\000\000\000\000\000\000\000\000\122\000\000\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\000\000\000\000\000\000\000\000\000\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\000\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\000\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\000\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\000\000\000\000\123\000\000\000\000\000\000\000\000\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\000\000\000\000\000\000\000\000\122\000\000\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\000\000\000\000\000\000\000\000\131\000\000\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\000\000\000\000\000\000\000\000\000\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\000\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\000\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\000\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\000\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\000\000\000\000\000\000\000\000\130\000\000\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\000\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \000\000\000\000\028\000\000\000\000\000\000\000\128\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\000\000\000\000\000\000\000\000\130\000\000\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\000\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\131\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \000\000\000\000\028\000\000\000\000\000\000\000\000\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\000\000\000\000\000\000\000\000\131\000\000\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\000\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\000\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\028\000\000\000\ + \000\000\134\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \133\000\000\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\085\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\000\000\000\000\000\000\ + \000\000\134\000\135\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\000\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\000\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\255\255\137\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\085\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\000\000\ + \000\000\000\000\000\000\137\000\000\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\000\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\000\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\136\000\000\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\085\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \000\000\000\000\000\000\000\000\137\000\000\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\000\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\085\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \000\000\000\000\000\000\000\000\137\000\000\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \000\000\000\000\000\000\000\000\144\000\000\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \000\000\000\000\000\000\000\000\000\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\000\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\000\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\000\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\000\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\000\000\ + \000\000\000\000\000\000\143\000\000\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\000\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\000\000\000\000\ + \032\000\000\000\000\000\000\000\141\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\000\000\ + \000\000\000\000\000\000\143\000\000\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\000\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\144\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\000\000\000\000\ + \032\000\000\000\000\000\000\000\000\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\000\000\ + \000\000\000\000\000\000\144\000\000\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\000\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\000\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\000\000"; + Lexing.lex_check = + "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\000\000\000\000\027\000\000\000\000\000\068\000\074\000\ + \078\000\105\000\125\000\140\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\ + \011\000\012\000\013\000\014\000\012\000\012\000\017\000\026\000\ + \038\000\038\000\026\000\039\000\039\000\039\000\039\000\039\000\ + \039\000\039\000\039\000\047\000\049\000\010\000\055\000\010\000\ + \058\000\082\000\014\000\082\000\083\000\084\000\026\000\082\000\ + \091\000\048\000\092\000\093\000\012\000\094\000\099\000\101\000\ + \103\000\126\000\014\000\014\000\014\000\014\000\014\000\014\000\ + \014\000\014\000\014\000\014\000\045\000\045\000\045\000\045\000\ + \045\000\045\000\045\000\045\000\045\000\045\000\048\000\092\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\010\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\255\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\004\000\003\000\003\000\004\000\004\000\004\000\ + \255\255\003\000\003\000\004\000\004\000\003\000\004\000\004\000\ + \004\000\037\000\037\000\037\000\037\000\037\000\037\000\037\000\ + \037\000\037\000\037\000\004\000\003\000\004\000\004\000\004\000\ + \004\000\004\000\036\000\255\255\036\000\255\255\037\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\054\000\054\000\054\000\054\000\054\000\054\000\054\000\ + \054\000\054\000\054\000\111\000\003\000\003\000\003\000\004\000\ + \037\000\003\000\110\000\110\000\255\255\255\255\037\000\070\000\ + \073\000\255\255\070\000\073\000\133\000\255\255\136\000\127\000\ + \018\000\127\000\111\000\018\000\255\255\127\000\255\255\255\255\ + \133\000\110\000\136\000\255\255\003\000\004\000\003\000\004\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\003\000\003\000\003\000\003\000\003\000\003\000\003\000\ + \003\000\007\000\018\000\255\255\007\000\007\000\007\000\255\255\ + \255\255\255\255\007\000\007\000\255\255\007\000\007\000\007\000\ + \255\255\071\000\255\255\255\255\071\000\139\000\124\000\139\000\ + \003\000\124\000\007\000\139\000\007\000\007\000\007\000\007\000\ + \007\000\255\255\255\255\043\000\043\000\255\255\255\255\008\000\ + \255\255\071\000\008\000\008\000\008\000\255\255\255\255\255\255\ + \008\000\008\000\255\255\008\000\008\000\008\000\255\255\255\255\ + \003\000\255\255\255\255\255\255\255\255\007\000\007\000\043\000\ + \008\000\003\000\008\000\008\000\008\000\008\000\008\000\255\255\ + \124\000\255\255\124\000\255\255\015\000\255\255\255\255\015\000\ + \015\000\015\000\043\000\255\255\255\255\015\000\015\000\255\255\ + \015\000\015\000\015\000\255\255\007\000\007\000\007\000\043\000\ + \255\255\043\000\255\255\008\000\008\000\015\000\255\255\015\000\ + \015\000\015\000\015\000\015\000\255\255\255\255\255\255\016\000\ + \255\255\255\255\016\000\016\000\016\000\255\255\255\255\016\000\ + \016\000\016\000\255\255\016\000\016\000\016\000\255\255\255\255\ + \255\255\255\255\008\000\255\255\008\000\255\255\255\255\255\255\ + \016\000\015\000\016\000\016\000\016\000\016\000\016\000\255\255\ + \255\255\020\000\255\255\020\000\020\000\020\000\020\000\020\000\ + \020\000\020\000\020\000\020\000\020\000\070\000\073\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\018\000\015\000\ + \020\000\015\000\255\255\255\255\016\000\255\255\255\255\020\000\ + \255\255\255\255\021\000\255\255\021\000\021\000\021\000\021\000\ + \021\000\021\000\021\000\021\000\021\000\021\000\255\255\255\255\ + \255\255\255\255\020\000\255\255\255\255\255\255\021\000\255\255\ + \020\000\021\000\016\000\255\255\016\000\255\255\255\255\020\000\ + \021\000\020\000\255\255\021\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\021\000\255\255\255\255\255\255\ + \072\000\072\000\255\255\021\000\072\000\255\255\021\000\255\255\ + \255\255\021\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \021\000\255\255\021\000\021\000\022\000\255\255\255\255\072\000\ + \255\255\072\000\255\255\255\255\021\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\071\000\ + \255\255\255\255\255\255\255\255\124\000\255\255\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \255\255\255\255\255\255\255\255\022\000\255\255\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \040\000\040\000\040\000\040\000\040\000\040\000\040\000\040\000\ + \040\000\040\000\104\000\255\255\255\255\104\000\255\255\255\255\ + \067\000\040\000\040\000\040\000\040\000\040\000\040\000\056\000\ + \056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\ + \056\000\255\255\104\000\255\255\255\255\255\255\255\255\067\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\040\000\040\000\040\000\040\000\040\000\040\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\067\000\067\000\ + \067\000\255\255\255\255\255\255\255\255\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\104\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\023\000\022\000\022\000\022\000\ + \022\000\022\000\022\000\022\000\022\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\072\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \255\255\255\255\255\255\255\255\023\000\255\255\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \041\000\041\000\041\000\041\000\041\000\041\000\041\000\041\000\ + \041\000\041\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\041\000\041\000\041\000\041\000\041\000\041\000\255\255\ + \255\255\255\255\255\255\255\255\041\000\098\000\098\000\098\000\ + \098\000\098\000\098\000\098\000\098\000\098\000\098\000\255\255\ + \255\255\255\255\138\000\255\255\255\255\138\000\255\255\041\000\ + \104\000\041\000\041\000\041\000\041\000\041\000\041\000\255\255\ + \255\255\255\255\255\255\255\255\041\000\255\255\041\000\255\255\ + \255\255\255\255\255\255\255\255\138\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\138\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\255\255\023\000\023\000\023\000\ + \023\000\023\000\023\000\023\000\023\000\024\000\255\255\255\255\ + \024\000\024\000\024\000\255\255\255\255\255\255\024\000\024\000\ + \255\255\024\000\024\000\024\000\100\000\100\000\100\000\100\000\ + \100\000\100\000\100\000\100\000\100\000\100\000\024\000\255\255\ + \024\000\024\000\024\000\024\000\024\000\255\255\255\255\079\000\ + \255\255\255\255\079\000\255\255\255\255\255\255\255\255\255\255\ + \044\000\044\000\044\000\044\000\044\000\044\000\044\000\044\000\ + \044\000\044\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\024\000\024\000\079\000\024\000\024\000\024\000\ + \024\000\024\000\024\000\024\000\024\000\024\000\024\000\024\000\ + \024\000\024\000\024\000\024\000\024\000\024\000\024\000\024\000\ + \024\000\024\000\024\000\024\000\024\000\024\000\024\000\044\000\ + \024\000\025\000\024\000\255\255\025\000\025\000\025\000\255\255\ + \255\255\255\255\025\000\025\000\255\255\025\000\025\000\025\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\079\000\025\000\255\255\025\000\025\000\025\000\025\000\ + \025\000\109\000\109\000\109\000\109\000\109\000\109\000\109\000\ + \109\000\109\000\109\000\112\000\112\000\112\000\112\000\112\000\ + \112\000\112\000\112\000\112\000\112\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\025\000\025\000\ + \138\000\025\000\025\000\025\000\025\000\025\000\025\000\025\000\ + \025\000\025\000\025\000\025\000\025\000\025\000\025\000\025\000\ + \025\000\025\000\025\000\025\000\025\000\025\000\025\000\025\000\ + \025\000\025\000\025\000\255\255\025\000\255\255\025\000\255\255\ + \255\255\255\255\255\255\024\000\024\000\024\000\024\000\024\000\ + \024\000\024\000\024\000\024\000\024\000\024\000\024\000\024\000\ + \024\000\024\000\024\000\024\000\024\000\024\000\024\000\024\000\ + \024\000\024\000\024\000\255\255\024\000\024\000\024\000\024\000\ + \024\000\024\000\024\000\024\000\053\000\053\000\053\000\053\000\ + \053\000\053\000\053\000\053\000\053\000\053\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\053\000\053\000\053\000\ + \053\000\053\000\053\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\053\000\053\000\053\000\ + \053\000\053\000\053\000\255\255\255\255\079\000\255\255\025\000\ + \025\000\025\000\025\000\025\000\025\000\025\000\025\000\025\000\ + \025\000\025\000\025\000\025\000\025\000\025\000\025\000\025\000\ + \025\000\025\000\025\000\025\000\025\000\025\000\025\000\029\000\ + \025\000\025\000\025\000\025\000\025\000\025\000\025\000\025\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\255\255\255\255\255\255\255\255\029\000\ + \255\255\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\042\000\042\000\042\000\042\000\042\000\ + \042\000\042\000\042\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\057\000\057\000\057\000\057\000\057\000\057\000\057\000\ + \057\000\057\000\057\000\255\255\255\255\255\255\255\255\042\000\ + \255\255\255\255\057\000\057\000\057\000\057\000\057\000\057\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\042\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\042\000\ + \255\255\042\000\057\000\057\000\057\000\057\000\057\000\057\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\255\255\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\031\000\ + \029\000\029\000\029\000\029\000\029\000\029\000\029\000\029\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\255\255\255\255\255\255\255\255\031\000\ + \255\255\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\255\255\255\255\255\255\255\255\066\000\ + \066\000\255\255\255\255\066\000\255\255\255\255\255\255\255\255\ + \097\000\097\000\097\000\097\000\097\000\097\000\097\000\097\000\ + \097\000\097\000\255\255\255\255\255\255\255\255\066\000\255\255\ + \066\000\097\000\097\000\097\000\097\000\097\000\097\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\066\000\066\000\ + \066\000\066\000\066\000\066\000\066\000\066\000\066\000\066\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\097\000\097\000\097\000\097\000\097\000\097\000\255\255\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\255\255\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\255\255\ + \031\000\031\000\031\000\031\000\031\000\031\000\031\000\031\000\ + \046\000\061\000\046\000\255\255\061\000\061\000\061\000\046\000\ + \255\255\255\255\061\000\061\000\255\255\061\000\061\000\061\000\ + \046\000\046\000\046\000\046\000\046\000\046\000\046\000\046\000\ + \046\000\046\000\061\000\255\255\061\000\061\000\061\000\061\000\ + \061\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \062\000\255\255\255\255\062\000\062\000\062\000\255\255\255\255\ + \255\255\062\000\062\000\255\255\062\000\062\000\062\000\255\255\ + \255\255\255\255\255\255\255\255\046\000\255\255\061\000\255\255\ + \255\255\062\000\046\000\062\000\062\000\062\000\062\000\062\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\046\000\255\255\ + \255\255\255\255\046\000\255\255\046\000\255\255\063\000\255\255\ + \046\000\063\000\063\000\063\000\061\000\255\255\061\000\063\000\ + \063\000\255\255\063\000\063\000\063\000\062\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\063\000\ + \255\255\063\000\063\000\063\000\063\000\063\000\066\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\064\000\255\255\255\255\ + \064\000\064\000\064\000\062\000\255\255\062\000\064\000\064\000\ + \255\255\064\000\064\000\064\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\063\000\255\255\255\255\064\000\255\255\ + \064\000\064\000\064\000\064\000\064\000\255\255\255\255\255\255\ + \065\000\255\255\255\255\065\000\065\000\065\000\255\255\255\255\ + \255\255\065\000\065\000\255\255\065\000\065\000\065\000\255\255\ + \255\255\063\000\255\255\063\000\255\255\255\255\255\255\255\255\ + \255\255\065\000\064\000\065\000\065\000\065\000\065\000\065\000\ + \102\000\102\000\102\000\102\000\102\000\102\000\102\000\102\000\ + \102\000\102\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\102\000\102\000\102\000\102\000\102\000\102\000\255\255\ + \064\000\255\255\064\000\255\255\255\255\065\000\255\255\255\255\ + \046\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\102\000\102\000\102\000\102\000\102\000\102\000\255\255\ + \255\255\255\255\255\255\065\000\255\255\065\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\114\000\ + \076\000\076\000\114\000\114\000\114\000\255\255\076\000\076\000\ + \114\000\114\000\076\000\114\000\114\000\114\000\108\000\108\000\ + \108\000\108\000\108\000\108\000\108\000\108\000\108\000\108\000\ + \114\000\076\000\114\000\114\000\114\000\114\000\114\000\108\000\ + \108\000\108\000\108\000\108\000\108\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\076\000\076\000\076\000\114\000\255\255\076\000\108\000\ + \108\000\108\000\108\000\108\000\108\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\076\000\114\000\076\000\114\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\076\000\076\000\ + \076\000\076\000\076\000\076\000\076\000\076\000\113\000\113\000\ + \113\000\113\000\113\000\113\000\113\000\113\000\113\000\113\000\ + \077\000\255\255\255\255\077\000\255\255\255\255\255\255\113\000\ + \113\000\113\000\113\000\113\000\113\000\076\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \077\000\255\255\255\255\255\255\255\255\077\000\077\000\255\255\ + \077\000\255\255\255\255\255\255\255\255\255\255\255\255\113\000\ + \113\000\113\000\113\000\113\000\113\000\076\000\255\255\255\255\ + \255\255\255\255\077\000\255\255\255\255\255\255\076\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\255\255\255\255\255\255\255\255\077\000\255\255\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\255\255\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\255\255\077\000\077\000\ + \077\000\077\000\077\000\077\000\077\000\077\000\077\000\081\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\255\255\255\255\255\255\255\255\081\000\ + \255\255\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\255\255\255\255\255\255\255\255\086\000\ + \255\255\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\255\255\255\255\255\255\255\255\255\255\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\255\255\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\255\255\ + \081\000\081\000\081\000\081\000\081\000\081\000\081\000\081\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\255\255\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\255\255\ + \086\000\086\000\086\000\086\000\086\000\086\000\086\000\086\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\255\255\255\255\255\255\255\255\087\000\255\255\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\255\255\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\088\000\087\000\ + \087\000\087\000\087\000\087\000\087\000\087\000\087\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\255\255\255\255\088\000\255\255\255\255\255\255\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\255\255\255\255\255\255\255\255\088\000\255\255\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\255\255\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\089\000\088\000\ + \088\000\088\000\088\000\088\000\088\000\088\000\088\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\255\255\255\255\089\000\255\255\255\255\255\255\255\255\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\255\255\255\255\255\255\255\255\089\000\255\255\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\255\255\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\255\255\089\000\ + \089\000\089\000\089\000\089\000\089\000\089\000\089\000\090\000\ + \255\255\090\000\255\255\255\255\106\000\255\255\090\000\106\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\090\000\ + \090\000\090\000\090\000\090\000\090\000\090\000\090\000\090\000\ + \090\000\255\255\106\000\255\255\106\000\255\255\255\255\255\255\ + \255\255\106\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\106\000\106\000\106\000\106\000\106\000\106\000\ + \106\000\106\000\106\000\106\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\090\000\255\255\255\255\255\255\255\255\ + \255\255\090\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\090\000\255\255\255\255\ + \255\255\090\000\255\255\090\000\255\255\255\255\106\000\090\000\ + \255\255\255\255\255\255\255\255\106\000\115\000\255\255\255\255\ + \115\000\115\000\115\000\255\255\255\255\255\255\115\000\115\000\ + \106\000\115\000\115\000\115\000\106\000\255\255\106\000\255\255\ + \255\255\255\255\106\000\255\255\255\255\255\255\115\000\255\255\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\255\255\ + \255\255\255\255\115\000\115\000\255\255\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\255\255\ + \115\000\255\255\115\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\106\000\255\255\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\255\255\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\255\255\115\000\115\000\115\000\115\000\ + \115\000\115\000\115\000\115\000\116\000\255\255\255\255\116\000\ + \116\000\116\000\255\255\255\255\255\255\116\000\116\000\255\255\ + \116\000\116\000\116\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\116\000\255\255\116\000\ + \116\000\116\000\116\000\116\000\255\255\255\255\255\255\255\255\ + \117\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\255\255\255\255\117\000\255\255\255\255\ + \255\255\116\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\255\255\255\255\255\255\116\000\ + \117\000\116\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \255\255\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \255\255\117\000\117\000\117\000\117\000\117\000\117\000\117\000\ + \117\000\118\000\255\255\255\255\118\000\118\000\118\000\255\255\ + \255\255\255\255\118\000\118\000\255\255\118\000\118\000\118\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\118\000\255\255\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\255\255\255\255\255\255\118\000\118\000\ + \255\255\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\255\255\118\000\255\255\118\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\255\255\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\255\255\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \119\000\255\255\255\255\119\000\119\000\119\000\255\255\255\255\ + \255\255\119\000\119\000\255\255\119\000\119\000\119\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\119\000\255\255\119\000\119\000\119\000\119\000\119\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\120\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\255\255\255\255\120\000\255\255\119\000\255\255\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\255\255\119\000\255\255\119\000\120\000\255\255\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\255\255\255\255\255\255\255\255\121\000\255\255\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\255\255\255\255\255\255\255\255\255\255\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\255\255\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\255\255\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\255\255\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\122\000\121\000\ + \121\000\121\000\121\000\121\000\121\000\121\000\121\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\255\255\255\255\122\000\255\255\255\255\255\255\255\255\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\255\255\255\255\255\255\255\255\122\000\255\255\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\255\255\255\255\255\255\255\255\128\000\255\255\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\255\255\255\255\255\255\255\255\255\255\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\255\255\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\255\255\122\000\ + \122\000\122\000\122\000\122\000\122\000\122\000\122\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\255\255\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\255\255\128\000\ + \128\000\128\000\128\000\128\000\128\000\128\000\128\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\255\255\255\255\255\255\255\255\129\000\255\255\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\255\255\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\130\000\129\000\129\000\ + \129\000\129\000\129\000\129\000\129\000\129\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \255\255\255\255\130\000\255\255\255\255\255\255\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\255\255\255\255\255\255\255\255\130\000\255\255\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\255\255\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\131\000\130\000\130\000\ + \130\000\130\000\130\000\130\000\130\000\130\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \255\255\255\255\131\000\255\255\255\255\255\255\255\255\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\255\255\255\255\255\255\255\255\131\000\255\255\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\255\255\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\255\255\131\000\131\000\ + \131\000\131\000\131\000\131\000\131\000\131\000\132\000\255\255\ + \255\255\132\000\255\255\255\255\255\255\255\255\255\255\255\255\ + \132\000\255\255\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\255\255\255\255\255\255\ + \255\255\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\255\255\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\255\255\132\000\132\000\132\000\132\000\132\000\132\000\ + \132\000\132\000\132\000\134\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\255\255\ + \255\255\255\255\255\255\134\000\255\255\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\255\255\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\255\255\134\000\134\000\134\000\134\000\ + \134\000\134\000\134\000\134\000\135\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\135\000\255\255\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \255\255\255\255\255\255\255\255\135\000\255\255\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\255\255\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\137\000\135\000\135\000\135\000\ + \135\000\135\000\135\000\135\000\135\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \255\255\255\255\255\255\255\255\137\000\255\255\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \255\255\255\255\255\255\255\255\255\255\255\255\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \255\255\255\255\255\255\255\255\141\000\255\255\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \255\255\255\255\255\255\255\255\255\255\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\255\255\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\255\255\137\000\137\000\137\000\ + \137\000\137\000\137\000\137\000\137\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\255\255\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\255\255\141\000\141\000\141\000\ + \141\000\141\000\141\000\141\000\141\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\255\255\ + \255\255\255\255\255\255\142\000\255\255\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\255\255\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\143\000\142\000\142\000\142\000\142\000\ + \142\000\142\000\142\000\142\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\255\255\255\255\ + \143\000\255\255\255\255\255\255\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\255\255\ + \255\255\255\255\255\255\143\000\255\255\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\255\255\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\144\000\143\000\143\000\143\000\143\000\ + \143\000\143\000\143\000\143\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\255\255\255\255\ + \144\000\255\255\255\255\255\255\255\255\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\255\255\ + \255\255\255\255\255\255\144\000\255\255\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\255\255\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\255\255\144\000\144\000\144\000\144\000\ + \144\000\144\000\144\000\144\000\255\255"; + Lexing.lex_base_code = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\010\000\036\000\000\000\012\000\000\000\000\000\ + \002\000\000\000\000\000\027\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\001\000\000\000\000\000\000\000\002\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\041\000\000\000\ + \249\000\000\000\000\000\039\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000"; + Lexing.lex_backtrk_code = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\ + \000\000\000\000\027\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\039\000\039\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000"; + Lexing.lex_default_code = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000"; + Lexing.lex_trans_code = + "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\001\000\000\000\036\000\036\000\000\000\036\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \001\000\000\000\000\000\001\000\022\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\007\000\001\000\000\000\000\000\ + \004\000\004\000\004\000\004\000\004\000\004\000\004\000\004\000\ + \004\000\004\000\004\000\004\000\004\000\004\000\004\000\004\000\ + \004\000\004\000\004\000\004\000\001\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\004\000\004\000\004\000\004\000\ + \004\000\004\000\004\000\004\000\004\000\004\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\000\000\000\000\000\000\000\000\ + \036\000\000\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \000\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\000\000\000\000\000\000\000\000\ + \036\000\000\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ + \000\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \000\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \000\000\036\000\036\000\036\000\036\000\036\000\036\000\036\000\ + \036\000\000\000"; + Lexing.lex_check_code = + "\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\014\000\071\000\106\000\110\000\071\000\106\000\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \014\000\255\255\071\000\000\000\072\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\066\000\067\000\255\255\255\255\ + \014\000\014\000\014\000\014\000\014\000\014\000\014\000\014\000\ + \014\000\014\000\066\000\066\000\066\000\066\000\066\000\066\000\ + \066\000\066\000\066\000\066\000\067\000\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\067\000\067\000\067\000\067\000\ + \067\000\067\000\067\000\067\000\067\000\067\000\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\255\255\255\255\255\255\255\255\ + \118\000\255\255\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \071\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \120\000\118\000\118\000\118\000\118\000\118\000\118\000\118\000\ + \118\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\255\255\255\255\255\255\255\255\ + \120\000\255\255\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\ + \255\255\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \255\255\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \255\255\120\000\120\000\120\000\120\000\120\000\120\000\120\000\ + \120\000\255\255"; + Lexing.lex_code = + "\255\004\255\255\005\255\255\007\255\006\255\255\003\255\000\004\ + \001\005\255\007\255\255\006\255\007\255\255\000\004\001\005\003\ + \006\002\007\255\001\255\255\000\001\255"; + } + let rec token c lexbuf = + (lexbuf.Lexing.lex_mem <- Array.create 8 (-1); + __ocaml_lex_token_rec c lexbuf 0) + and __ocaml_lex_token_rec c lexbuf __ocaml_lex_state = + match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state + lexbuf + with + | 0 -> (update_loc c None 1 false 0; NEWLINE) + | 1 -> + let x = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in BLANKS x + | 2 -> + let x = + Lexing.sub_lexeme lexbuf + (lexbuf.Lexing.lex_start_pos + 1) + (lexbuf.Lexing.lex_curr_pos + (-1)) + in LABEL x + | 3 -> + let x = + Lexing.sub_lexeme lexbuf + (lexbuf.Lexing.lex_start_pos + 1) + (lexbuf.Lexing.lex_curr_pos + (-1)) + in OPTLABEL x + | 4 -> + let x = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in LIDENT x + | 5 -> + let x = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in UIDENT x + | 6 -> + let i = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in + (try INT (int_of_string i, i) + with + | Failure _ -> + err (Literal_overflow "int") (Loc.of_lexbuf lexbuf)) + | 7 -> + let f = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in + (try FLOAT (float_of_string f, f) + with + | Failure _ -> + err (Literal_overflow "float") + (Loc.of_lexbuf lexbuf)) + | 8 -> + let i = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + (lexbuf.Lexing.lex_curr_pos + (-1)) + in + (try INT32 (Int32.of_string i, i) + with + | Failure _ -> + err (Literal_overflow "int32") + (Loc.of_lexbuf lexbuf)) + | 9 -> + let i = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + (lexbuf.Lexing.lex_curr_pos + (-1)) + in + (try INT64 (Int64.of_string i, i) + with + | Failure _ -> + err (Literal_overflow "int64") + (Loc.of_lexbuf lexbuf)) + | 10 -> + let i = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + (lexbuf.Lexing.lex_curr_pos + (-1)) + in + (try NATIVEINT (Nativeint.of_string i, i) + with + | Failure _ -> + err (Literal_overflow "nativeint") + (Loc.of_lexbuf lexbuf)) + | 11 -> + (with_curr_loc string c; + let s = buff_contents c in STRING (TokenEval.string s, s)) + | 12 -> + let x = + Lexing.sub_lexeme lexbuf + (lexbuf.Lexing.lex_start_pos + 1) + (lexbuf.Lexing.lex_curr_pos + (-1)) + in + (update_loc c None 1 false 1; CHAR (TokenEval.char x, x)) + | 13 -> + let x = + Lexing.sub_lexeme lexbuf + (lexbuf.Lexing.lex_start_pos + 1) + (lexbuf.Lexing.lex_curr_pos + (-1)) + in CHAR (TokenEval.char x, x) + | 14 -> + let c = + Lexing.sub_lexeme_char lexbuf + (lexbuf.Lexing.lex_start_pos + 2) + in + err (Illegal_escape (String.make 1 c)) + (Loc.of_lexbuf lexbuf) + | 15 -> + (store c; COMMENT (parse_nested comment (in_comment c))) + | 16 -> + (warn Comment_start (Loc.of_lexbuf lexbuf); + parse comment (in_comment c); + COMMENT (buff_contents c)) + | 17 -> + (warn Comment_not_end (Loc.of_lexbuf lexbuf); + move_start_p (-1) c; + SYMBOL "*") + | 18 -> + if quotations c + then mk_quotation quotation c "" "" 2 + else parse (symbolchar_star "<<") c + | 19 -> + if quotations c + then + QUOTATION + { + + q_name = ""; + q_loc = ""; + q_shift = 2; + q_contents = ""; + } + else parse (symbolchar_star "<<>>") c + | 20 -> + if quotations c + then with_curr_loc maybe_quotation_at c + else parse (symbolchar_star "<@") c + | 21 -> + if quotations c + then with_curr_loc maybe_quotation_colon c + else parse (symbolchar_star "<:") c + | 22 -> + let num = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) + lexbuf.Lexing.lex_mem.(1) + and name = + Lexing.sub_lexeme_opt lexbuf lexbuf.Lexing.lex_mem.(3) + lexbuf.Lexing.lex_mem.(2) in + let inum = int_of_string num + in + (update_loc c name inum true 0; + LINE_DIRECTIVE (inum, name)) + | 23 -> + let x = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in SYMBOL x + | 24 -> + if quotations c + then with_curr_loc dollar (shift 1 c) + else parse (symbolchar_star "$") c + | 25 -> + let x = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in SYMBOL x + | 26 -> + let x = + Lexing.sub_lexeme lexbuf + (lexbuf.Lexing.lex_start_pos + 1) + lexbuf.Lexing.lex_curr_pos + in ESCAPED_IDENT x + | 27 -> + let pos = lexbuf.lex_curr_p + in + (lexbuf.lex_curr_p <- + { + (pos) + with + + pos_bol = pos.pos_bol + 1; + pos_cnum = pos.pos_cnum + 1; + }; + EOI) + | 28 -> + let c = + Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos + in err (Illegal_character c) (Loc.of_lexbuf lexbuf) + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_token_rec c lexbuf __ocaml_lex_state) + and comment c lexbuf = __ocaml_lex_comment_rec c lexbuf 77 + and __ocaml_lex_comment_rec c lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf + with + | 0 -> (store c; with_curr_loc comment c; parse comment c) + | 1 -> store c + | 2 -> + (store c; + if quotations c then with_curr_loc quotation c else (); + parse comment c) + | 3 -> store_parse comment c + | 4 -> + (store c; + (try with_curr_loc string c + with + | Loc.Exc_located (_, (Error.E Unterminated_string)) -> + err Unterminated_string_in_comment (loc c)); + Buffer.add_char c.buffer '"'; + parse comment c) + | 5 -> store_parse comment c + | 6 -> store_parse comment c + | 7 -> (update_loc c None 1 false 1; store_parse comment c) + | 8 -> store_parse comment c + | 9 -> store_parse comment c + | 10 -> store_parse comment c + | 11 -> store_parse comment c + | 12 -> err Unterminated_comment (loc c) + | 13 -> (update_loc c None 1 false 0; store_parse comment c) + | 14 -> store_parse comment c + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_comment_rec c lexbuf __ocaml_lex_state) + and string c lexbuf = + (lexbuf.Lexing.lex_mem <- Array.create 2 (-1); + __ocaml_lex_string_rec c lexbuf 104) + and __ocaml_lex_string_rec c lexbuf __ocaml_lex_state = + match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state + lexbuf + with + | 0 -> set_start_p c + | 1 -> + let space = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_mem.(0) + lexbuf.Lexing.lex_curr_pos + in + (update_loc c None 1 false (String.length space); + store_parse string c) + | 2 -> store_parse string c + | 3 -> store_parse string c + | 4 -> store_parse string c + | 5 -> + let x = + Lexing.sub_lexeme_char lexbuf + (lexbuf.Lexing.lex_start_pos + 1) + in + if is_in_comment c + then store_parse string c + else + (warn (Illegal_escape (String.make 1 x)) + (Loc.of_lexbuf lexbuf); + store_parse string c) + | 6 -> (update_loc c None 1 false 0; store_parse string c) + | 7 -> err Unterminated_string (loc c) + | 8 -> store_parse string c + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_string_rec c lexbuf __ocaml_lex_state) + and symbolchar_star beginning c lexbuf = + __ocaml_lex_symbolchar_star_rec beginning c lexbuf 114 + and + __ocaml_lex_symbolchar_star_rec beginning c lexbuf + __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf + with + | 0 -> + let tok = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in + (move_start_p (-String.length beginning) c; + SYMBOL (beginning ^ tok)) + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_symbolchar_star_rec beginning c lexbuf + __ocaml_lex_state) + and maybe_quotation_at c lexbuf = + __ocaml_lex_maybe_quotation_at_rec c lexbuf 115 + and + __ocaml_lex_maybe_quotation_at_rec c lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf + with + | 0 -> + let loc = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + (lexbuf.Lexing.lex_curr_pos + (-1)) + in + mk_quotation quotation c "" loc (3 + (String.length loc)) + | 1 -> + let tok = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in SYMBOL ("<@" ^ tok) + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_maybe_quotation_at_rec c lexbuf + __ocaml_lex_state) + and maybe_quotation_colon c lexbuf = + (lexbuf.Lexing.lex_mem <- Array.create 2 (-1); + __ocaml_lex_maybe_quotation_colon_rec c lexbuf 118) + and + __ocaml_lex_maybe_quotation_colon_rec c lexbuf + __ocaml_lex_state = + match Lexing.new_engine __ocaml_lex_tables __ocaml_lex_state + lexbuf + with + | 0 -> + let name = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + (lexbuf.Lexing.lex_curr_pos + (-1)) + in + mk_quotation quotation c name "" + (3 + (String.length name)) + | 1 -> + let name = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_mem.(0) + and loc = + Lexing.sub_lexeme lexbuf (lexbuf.Lexing.lex_mem.(0) + 1) + (lexbuf.Lexing.lex_curr_pos + (-1)) + in + mk_quotation quotation c name loc + ((4 + (String.length loc)) + (String.length name)) + | 2 -> + let tok = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + lexbuf.Lexing.lex_curr_pos + in SYMBOL ("<:" ^ tok) + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_maybe_quotation_colon_rec c lexbuf + __ocaml_lex_state) + and quotation c lexbuf = __ocaml_lex_quotation_rec c lexbuf 124 + and __ocaml_lex_quotation_rec c lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf + with + | 0 -> (store c; with_curr_loc quotation c; parse quotation c) + | 1 -> store c + | 2 -> err Unterminated_quotation (loc c) + | 3 -> (update_loc c None 1 false 0; store_parse quotation c) + | 4 -> store_parse quotation c + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_quotation_rec c lexbuf __ocaml_lex_state) + and dollar c lexbuf = __ocaml_lex_dollar_rec c lexbuf 132 + and __ocaml_lex_dollar_rec c lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf + with + | 0 -> (set_start_p c; ANTIQUOT ("", "")) + | 1 -> + let name = + Lexing.sub_lexeme lexbuf lexbuf.Lexing.lex_start_pos + (lexbuf.Lexing.lex_curr_pos + (-1)) + in + with_curr_loc (antiquot name) + (shift (1 + (String.length name)) c) + | 2 -> store_parse (antiquot "") c + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_dollar_rec c lexbuf __ocaml_lex_state) + and antiquot name c lexbuf = + __ocaml_lex_antiquot_rec name c lexbuf 138 + and __ocaml_lex_antiquot_rec name c lexbuf __ocaml_lex_state = + match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf + with + | 0 -> (set_start_p c; ANTIQUOT (name, buff_contents c)) + | 1 -> err Unterminated_antiquot (loc c) + | 2 -> + (update_loc c None 1 false 0; + store_parse (antiquot name) c) + | 3 -> + (store c; + with_curr_loc quotation c; + parse (antiquot name) c) + | 4 -> store_parse (antiquot name) c + | __ocaml_lex_state -> + (lexbuf.Lexing.refill_buff lexbuf; + __ocaml_lex_antiquot_rec name c lexbuf __ocaml_lex_state) + let lexing_store s buff max = + let rec self n s = + if n >= max + then n + else + (match Stream.peek s with + | Some x -> (Stream.junk s; buff.[n] <- x; succ n) + | _ -> n) + in self 0 s + let from_context c = + let next _ = + let tok = with_curr_loc token c in + let loc = Loc.of_lexbuf c.lexbuf in Some (tok, loc) + in Stream.from next + let from_lexbuf ?(quotations = true) lb = + let c = + { + (default_context lb) + with + + loc = Loc.of_lexbuf lb; + quotations = quotations; + } + in from_context c + let setup_loc lb loc = + let start_pos = Loc.start_pos loc + in + (lb.lex_abs_pos <- start_pos.pos_cnum; + lb.lex_curr_p <- start_pos) + let from_string ?quotations loc str = + let lb = Lexing.from_string str + in (setup_loc lb loc; from_lexbuf ?quotations lb) + let from_stream ?quotations loc strm = + let lb = Lexing.from_function (lexing_store strm) + in (setup_loc lb loc; from_lexbuf ?quotations lb) + let mk () loc strm = + from_stream ~quotations: !Camlp4_config.quotations loc strm + end + end + module Camlp4Ast = + struct + module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc = + struct + module Loc = Loc + module Ast = + struct + include Sig.MakeCamlp4Ast(Loc) + let safe_string_escaped s = + if + ((String.length s) > 2) && + ((s.[0] = '\\') && (s.[1] = '$')) + then s + else String.escaped s + end + include Ast + external loc_of_ctyp : ctyp -> Loc.t = "%field0" + external loc_of_patt : patt -> Loc.t = "%field0" + external loc_of_expr : expr -> Loc.t = "%field0" + external loc_of_module_type : module_type -> Loc.t = "%field0" + external loc_of_module_expr : module_expr -> Loc.t = "%field0" + external loc_of_sig_item : sig_item -> Loc.t = "%field0" + external loc_of_str_item : str_item -> Loc.t = "%field0" + external loc_of_class_type : class_type -> Loc.t = "%field0" + external loc_of_class_sig_item : class_sig_item -> Loc.t = + "%field0" + external loc_of_class_expr : class_expr -> Loc.t = "%field0" + external loc_of_class_str_item : class_str_item -> Loc.t = + "%field0" + external loc_of_with_constr : with_constr -> Loc.t = "%field0" + external loc_of_binding : binding -> Loc.t = "%field0" + external loc_of_module_binding : module_binding -> Loc.t = + "%field0" + external loc_of_match_case : match_case -> Loc.t = "%field0" + external loc_of_ident : ident -> Loc.t = "%field0" + module Meta = + struct + module type META_LOC = + sig + val meta_loc_patt : Loc.t -> Loc.t -> Ast.patt + val meta_loc_expr : Loc.t -> Loc.t -> Ast.expr + end + module MetaLoc = + struct + let meta_loc_patt _loc location = + let (a, b, c, d, e, f, g, h) = Loc.to_tuple location + in + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Loc"), + Ast.IdLid (_loc, "of_tuple"))), + Ast.PaTup (_loc, + Ast.PaCom (_loc, + Ast.PaStr (_loc, Ast.safe_string_escaped a), + Ast.PaCom (_loc, + Ast.PaCom (_loc, + Ast.PaCom (_loc, + Ast.PaCom (_loc, + Ast.PaCom (_loc, + Ast.PaCom (_loc, + Ast.PaInt (_loc, string_of_int b), + Ast.PaInt (_loc, string_of_int c)), + Ast.PaInt (_loc, string_of_int d)), + Ast.PaInt (_loc, string_of_int e)), + Ast.PaInt (_loc, string_of_int f)), + Ast.PaInt (_loc, string_of_int g)), + if h + then + Ast.PaId (_loc, Ast.IdUid (_loc, "True")) + else + Ast.PaId (_loc, Ast.IdUid (_loc, "False")))))) + let meta_loc_expr _loc location = + let (a, b, c, d, e, f, g, h) = Loc.to_tuple location + in + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Loc"), + Ast.IdLid (_loc, "of_tuple"))), + Ast.ExTup (_loc, + Ast.ExCom (_loc, + Ast.ExStr (_loc, Ast.safe_string_escaped a), + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExInt (_loc, string_of_int b), + Ast.ExInt (_loc, string_of_int c)), + Ast.ExInt (_loc, string_of_int d)), + Ast.ExInt (_loc, string_of_int e)), + Ast.ExInt (_loc, string_of_int f)), + Ast.ExInt (_loc, string_of_int g)), + if h + then + Ast.ExId (_loc, Ast.IdUid (_loc, "True")) + else + Ast.ExId (_loc, Ast.IdUid (_loc, "False")))))) + end + module MetaGhostLoc = + struct + let meta_loc_patt _loc _ = + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Loc"), + Ast.IdLid (_loc, "ghost"))) + let meta_loc_expr _loc _ = + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Loc"), + Ast.IdLid (_loc, "ghost"))) + end + module MetaLocVar = + struct + let meta_loc_patt _loc _ = + Ast.PaId (_loc, Ast.IdLid (_loc, !Loc.name)) + let meta_loc_expr _loc _ = + Ast.ExId (_loc, Ast.IdLid (_loc, !Loc.name)) + end + module Make (MetaLoc : META_LOC) = + struct + open MetaLoc + let meta_acc_Loc_t = meta_loc_expr + module Expr = + struct + let meta_string _loc s = Ast.ExStr (_loc, s) + let meta_int _loc s = Ast.ExInt (_loc, s) + let meta_float _loc s = Ast.ExFlo (_loc, s) + let meta_char _loc s = Ast.ExChr (_loc, s) + let meta_bool _loc = + function + | false -> + Ast.ExId (_loc, Ast.IdUid (_loc, "False")) + | true -> Ast.ExId (_loc, Ast.IdUid (_loc, "True")) + let rec meta_list mf_a _loc = + function + | [] -> Ast.ExId (_loc, Ast.IdUid (_loc, "[]")) + | x :: xs -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "::")), + mf_a _loc x), + meta_list mf_a _loc xs) + let rec meta_binding _loc = + function + | Ast.BiAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.BiEq (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiEq"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_expr _loc x2) + | Ast.BiSem (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiSem"))), + meta_acc_Loc_t _loc x0), + meta_binding _loc x1), + meta_binding _loc x2) + | Ast.BiAnd (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiAnd"))), + meta_acc_Loc_t _loc x0), + meta_binding _loc x1), + meta_binding _loc x2) + | Ast.BiNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiNil"))), + meta_acc_Loc_t _loc x0) + and meta_class_expr _loc = + function + | Ast.CeAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.CeEq (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeEq"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_class_expr _loc x2) + | Ast.CeAnd (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeAnd"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_class_expr _loc x2) + | Ast.CeTyc (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeTyc"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_class_type _loc x2) + | Ast.CeStr (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeStr"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_class_str_item _loc x2) + | Ast.CeLet (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeLet"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_binding _loc x2), + meta_class_expr _loc x3) + | Ast.CeFun (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeFun"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_class_expr _loc x2) + | Ast.CeCon (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeCon"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_ident _loc x2), + meta_ctyp _loc x3) + | Ast.CeApp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeApp"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_expr _loc x2) + | Ast.CeNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeNil"))), + meta_acc_Loc_t _loc x0) + and meta_class_sig_item _loc = + function + | Ast.CgAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.CgVir (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgVir"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_ctyp _loc x3) + | Ast.CgVal (x0, x1, x2, x3, x4) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgVal"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_meta_bool _loc x3), + meta_ctyp _loc x4) + | Ast.CgMth (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgMth"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_ctyp _loc x3) + | Ast.CgInh (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgInh"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1) + | Ast.CgSem (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgSem"))), + meta_acc_Loc_t _loc x0), + meta_class_sig_item _loc x1), + meta_class_sig_item _loc x2) + | Ast.CgCtr (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgCtr"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.CgNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgNil"))), + meta_acc_Loc_t _loc x0) + and meta_class_str_item _loc = + function + | Ast.CrAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.CrVvr (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrVvr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_ctyp _loc x3) + | Ast.CrVir (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrVir"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_ctyp _loc x3) + | Ast.CrVal (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrVal"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_expr _loc x3) + | Ast.CrMth (x0, x1, x2, x3, x4) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrMth"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_expr _loc x3), + meta_ctyp _loc x4) + | Ast.CrIni (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrIni"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.CrInh (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrInh"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_string _loc x2) + | Ast.CrCtr (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrCtr"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.CrSem (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrSem"))), + meta_acc_Loc_t _loc x0), + meta_class_str_item _loc x1), + meta_class_str_item _loc x2) + | Ast.CrNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrNil"))), + meta_acc_Loc_t _loc x0) + and meta_class_type _loc = + function + | Ast.CtAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.CtEq (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtEq"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1), + meta_class_type _loc x2) + | Ast.CtCol (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtCol"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1), + meta_class_type _loc x2) + | Ast.CtAnd (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtAnd"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1), + meta_class_type _loc x2) + | Ast.CtSig (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtSig"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_class_sig_item _loc x2) + | Ast.CtFun (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtFun"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_class_type _loc x2) + | Ast.CtCon (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtCon"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_ident _loc x2), + meta_ctyp _loc x3) + | Ast.CtNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtNil"))), + meta_acc_Loc_t _loc x0) + and meta_ctyp _loc = + function + | Ast.TyAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.TyOfAmp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyOfAmp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyAmp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAmp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyVrnInfSup (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrnInfSup"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyVrnInf (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrnInf"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyVrnSup (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrnSup"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyVrnEq (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrnEq"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TySta (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TySta"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyTup (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyTup"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyMut (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyMut"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyPrv (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyPrv"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyOr (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyOr"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyAnd (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAnd"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyOf (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyOf"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TySum (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TySum"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyCom (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyCom"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TySem (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TySem"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyCol (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyCol"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyRec (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyRec"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyVrn (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrn"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.TyQuM (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyQuM"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.TyQuP (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyQuP"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.TyQuo (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyQuo"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.TyPol (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyPol"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyOlb (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyOlb"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2) + | Ast.TyObj (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyObj"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_meta_bool _loc x2) + | Ast.TyDcl (x0, x1, x2, x3, x4) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyDcl"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_list meta_ctyp _loc x2), + meta_ctyp _loc x3), + meta_list + (fun _loc (x1, x2) -> + Ast.ExTup (_loc, + Ast.ExCom (_loc, meta_ctyp _loc x1, + meta_ctyp _loc x2))) + _loc x4) + | Ast.TyMan (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyMan"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyId (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.TyLab (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyLab"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2) + | Ast.TyCls (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyCls"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.TyArr (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyArr"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyApp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyApp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyAny x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAny"))), + meta_acc_Loc_t _loc x0) + | Ast.TyAli (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAli"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyNil"))), + meta_acc_Loc_t _loc x0) + and meta_expr _loc = + function + | Ast.ExWhi (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExWhi"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExVrn (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExVrn"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExTyc (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExTyc"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_ctyp _loc x2) + | Ast.ExCom (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExCom"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExTup (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExTup"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExTry (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExTry"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_match_case _loc x2) + | Ast.ExStr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExStr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExSte (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExSte"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExSnd (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExSnd"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_string _loc x2) + | Ast.ExSeq (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExSeq"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExRec (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExRec"))), + meta_acc_Loc_t _loc x0), + meta_binding _loc x1), + meta_expr _loc x2) + | Ast.ExOvr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExOvr"))), + meta_acc_Loc_t _loc x0), + meta_binding _loc x1) + | Ast.ExOlb (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExOlb"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2) + | Ast.ExObj (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExObj"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_class_str_item _loc x2) + | Ast.ExNew (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExNew"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.ExMat (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExMat"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_match_case _loc x2) + | Ast.ExLmd (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExLmd"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_expr _loc x2), + meta_expr _loc x3) + | Ast.ExLet (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExLet"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_binding _loc x2), + meta_expr _loc x3) + | Ast.ExLaz (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExLaz"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExLab (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExLab"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2) + | Ast.ExNativeInt (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExNativeInt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExInt64 (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExInt64"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExInt32 (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExInt32"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExInt (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExInt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExIfe (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExIfe"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2), + meta_expr _loc x3) + | Ast.ExFun (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExFun"))), + meta_acc_Loc_t _loc x0), + meta_match_case _loc x1) + | Ast.ExFor (x0, x1, x2, x3, x4, x5) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExFor"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2), + meta_expr _loc x3), + meta_meta_bool _loc x4), + meta_expr _loc x5) + | Ast.ExFlo (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExFlo"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExCoe (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExCoe"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_ctyp _loc x2), + meta_ctyp _loc x3) + | Ast.ExChr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExChr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExAss (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAss"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExAsr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAsr"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExAsf x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAsf"))), + meta_acc_Loc_t _loc x0) + | Ast.ExSem (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExSem"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExArr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExArr"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExAre (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAre"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExApp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExApp"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.ExAcc (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAcc"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExId (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.ExNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExNil"))), + meta_acc_Loc_t _loc x0) + and meta_ident _loc = + function + | Ast.IdAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.IdUid (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdUid"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.IdLid (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdLid"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.IdApp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdApp"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1), + meta_ident _loc x2) + | Ast.IdAcc (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdAcc"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1), + meta_ident _loc x2) + and meta_match_case _loc = + function + | Ast.McAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.McArr (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "McArr"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_expr _loc x2), + meta_expr _loc x3) + | Ast.McOr (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "McOr"))), + meta_acc_Loc_t _loc x0), + meta_match_case _loc x1), + meta_match_case _loc x2) + | Ast.McNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "McNil"))), + meta_acc_Loc_t _loc x0) + and meta_meta_bool _loc = + function + | Ast.BAnt x0 -> Ast.ExAnt (_loc, x0) + | Ast.BFalse -> + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BFalse"))) + | Ast.BTrue -> + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BTrue"))) + and meta_meta_option mf_a _loc = + function + | Ast.OAnt x0 -> Ast.ExAnt (_loc, x0) + | Ast.OSome x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "OSome"))), + mf_a _loc x0) + | Ast.ONone -> + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ONone"))) + and meta_module_binding _loc = + function + | Ast.MbAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.MbCol (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbCol"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2) + | Ast.MbColEq (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbColEq"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2), + meta_module_expr _loc x3) + | Ast.MbAnd (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbAnd"))), + meta_acc_Loc_t _loc x0), + meta_module_binding _loc x1), + meta_module_binding _loc x2) + | Ast.MbNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbNil"))), + meta_acc_Loc_t _loc x0) + and meta_module_expr _loc = + function + | Ast.MeAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.MeTyc (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeTyc"))), + meta_acc_Loc_t _loc x0), + meta_module_expr _loc x1), + meta_module_type _loc x2) + | Ast.MeStr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeStr"))), + meta_acc_Loc_t _loc x0), + meta_str_item _loc x1) + | Ast.MeFun (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeFun"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2), + meta_module_expr _loc x3) + | Ast.MeApp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeApp"))), + meta_acc_Loc_t _loc x0), + meta_module_expr _loc x1), + meta_module_expr _loc x2) + | Ast.MeId (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + and meta_module_type _loc = + function + | Ast.MtAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.MtWit (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtWit"))), + meta_acc_Loc_t _loc x0), + meta_module_type _loc x1), + meta_with_constr _loc x2) + | Ast.MtSig (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtSig"))), + meta_acc_Loc_t _loc x0), + meta_sig_item _loc x1) + | Ast.MtQuo (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtQuo"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.MtFun (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtFun"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2), + meta_module_type _loc x3) + | Ast.MtId (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + and meta_patt _loc = + function + | Ast.PaVrn (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaVrn"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaTyp (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaTyp"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.PaTyc (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaTyc"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_ctyp _loc x2) + | Ast.PaTup (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaTup"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1) + | Ast.PaStr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaStr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaEq (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaEq"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaRec (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaRec"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1) + | Ast.PaRng (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaRng"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaOrp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaOrp"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaOlbi (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaOlbi"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_patt _loc x2), + meta_expr _loc x3) + | Ast.PaOlb (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaOlb"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_patt _loc x2) + | Ast.PaLab (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaLab"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_patt _loc x2) + | Ast.PaFlo (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaFlo"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaNativeInt (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaNativeInt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaInt64 (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaInt64"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaInt32 (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaInt32"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaInt (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaInt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaChr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaChr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaSem (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaSem"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaCom (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaCom"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaArr (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaArr"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1) + | Ast.PaApp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaApp"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaAny x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaAny"))), + meta_acc_Loc_t _loc x0) + | Ast.PaAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.PaAli (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaAli"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaId (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.PaNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaNil"))), + meta_acc_Loc_t _loc x0) + and meta_sig_item _loc = + function + | Ast.SgAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.SgVal (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgVal"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2) + | Ast.SgTyp (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgTyp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.SgOpn (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgOpn"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.SgMty (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgMty"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2) + | Ast.SgRecMod (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgRecMod"))), + meta_acc_Loc_t _loc x0), + meta_module_binding _loc x1) + | Ast.SgMod (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgMod"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2) + | Ast.SgInc (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgInc"))), + meta_acc_Loc_t _loc x0), + meta_module_type _loc x1) + | Ast.SgExt (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgExt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2), + meta_string _loc x3) + | Ast.SgExc (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgExc"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.SgDir (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgDir"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2) + | Ast.SgSem (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgSem"))), + meta_acc_Loc_t _loc x0), + meta_sig_item _loc x1), + meta_sig_item _loc x2) + | Ast.SgClt (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgClt"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1) + | Ast.SgCls (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgCls"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1) + | Ast.SgNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgNil"))), + meta_acc_Loc_t _loc x0) + and meta_str_item _loc = + function + | Ast.StAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.StVal (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StVal"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_binding _loc x2) + | Ast.StTyp (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StTyp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.StOpn (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StOpn"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.StMty (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StMty"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2) + | Ast.StRecMod (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StRecMod"))), + meta_acc_Loc_t _loc x0), + meta_module_binding _loc x1) + | Ast.StMod (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StMod"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_expr _loc x2) + | Ast.StInc (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StInc"))), + meta_acc_Loc_t _loc x0), + meta_module_expr _loc x1) + | Ast.StExt (x0, x1, x2, x3) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StExt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2), + meta_string _loc x3) + | Ast.StExp (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StExp"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.StExc (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StExc"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_meta_option meta_ident _loc x2) + | Ast.StDir (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StDir"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2) + | Ast.StSem (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StSem"))), + meta_acc_Loc_t _loc x0), + meta_str_item _loc x1), + meta_str_item _loc x2) + | Ast.StClt (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StClt"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1) + | Ast.StCls (x0, x1) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StCls"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1) + | Ast.StNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StNil"))), + meta_acc_Loc_t _loc x0) + and meta_with_constr _loc = + function + | Ast.WcAnt (x0, x1) -> Ast.ExAnt (x0, x1) + | Ast.WcAnd (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcAnd"))), + meta_acc_Loc_t _loc x0), + meta_with_constr _loc x1), + meta_with_constr _loc x2) + | Ast.WcMod (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcMod"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1), + meta_ident _loc x2) + | Ast.WcTyp (x0, x1, x2) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcTyp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.WcNil x0 -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcNil"))), + meta_acc_Loc_t _loc x0) + end + let meta_acc_Loc_t = meta_loc_patt + module Patt = + struct + let meta_string _loc s = Ast.PaStr (_loc, s) + let meta_int _loc s = Ast.PaInt (_loc, s) + let meta_float _loc s = Ast.PaFlo (_loc, s) + let meta_char _loc s = Ast.PaChr (_loc, s) + let meta_bool _loc = + function + | false -> + Ast.PaId (_loc, Ast.IdUid (_loc, "False")) + | true -> Ast.PaId (_loc, Ast.IdUid (_loc, "True")) + let rec meta_list mf_a _loc = + function + | [] -> Ast.PaId (_loc, Ast.IdUid (_loc, "[]")) + | x :: xs -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, "::")), + mf_a _loc x), + meta_list mf_a _loc xs) + let rec meta_binding _loc = + function + | Ast.BiAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.BiEq (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiEq"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_expr _loc x2) + | Ast.BiSem (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiSem"))), + meta_acc_Loc_t _loc x0), + meta_binding _loc x1), + meta_binding _loc x2) + | Ast.BiAnd (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiAnd"))), + meta_acc_Loc_t _loc x0), + meta_binding _loc x1), + meta_binding _loc x2) + | Ast.BiNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiNil"))), + meta_acc_Loc_t _loc x0) + and meta_class_expr _loc = + function + | Ast.CeAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.CeEq (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeEq"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_class_expr _loc x2) + | Ast.CeAnd (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeAnd"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_class_expr _loc x2) + | Ast.CeTyc (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeTyc"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_class_type _loc x2) + | Ast.CeStr (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeStr"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_class_str_item _loc x2) + | Ast.CeLet (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeLet"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_binding _loc x2), + meta_class_expr _loc x3) + | Ast.CeFun (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeFun"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_class_expr _loc x2) + | Ast.CeCon (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeCon"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_ident _loc x2), + meta_ctyp _loc x3) + | Ast.CeApp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeApp"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_expr _loc x2) + | Ast.CeNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeNil"))), + meta_acc_Loc_t _loc x0) + and meta_class_sig_item _loc = + function + | Ast.CgAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.CgVir (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgVir"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_ctyp _loc x3) + | Ast.CgVal (x0, x1, x2, x3, x4) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgVal"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_meta_bool _loc x3), + meta_ctyp _loc x4) + | Ast.CgMth (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgMth"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_ctyp _loc x3) + | Ast.CgInh (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgInh"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1) + | Ast.CgSem (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgSem"))), + meta_acc_Loc_t _loc x0), + meta_class_sig_item _loc x1), + meta_class_sig_item _loc x2) + | Ast.CgCtr (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgCtr"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.CgNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgNil"))), + meta_acc_Loc_t _loc x0) + and meta_class_str_item _loc = + function + | Ast.CrAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.CrVvr (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrVvr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_ctyp _loc x3) + | Ast.CrVir (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrVir"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_ctyp _loc x3) + | Ast.CrVal (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrVal"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_expr _loc x3) + | Ast.CrMth (x0, x1, x2, x3, x4) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrMth"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_meta_bool _loc x2), + meta_expr _loc x3), + meta_ctyp _loc x4) + | Ast.CrIni (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrIni"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.CrInh (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrInh"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1), + meta_string _loc x2) + | Ast.CrCtr (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrCtr"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.CrSem (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrSem"))), + meta_acc_Loc_t _loc x0), + meta_class_str_item _loc x1), + meta_class_str_item _loc x2) + | Ast.CrNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrNil"))), + meta_acc_Loc_t _loc x0) + and meta_class_type _loc = + function + | Ast.CtAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.CtEq (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtEq"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1), + meta_class_type _loc x2) + | Ast.CtCol (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtCol"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1), + meta_class_type _loc x2) + | Ast.CtAnd (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtAnd"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1), + meta_class_type _loc x2) + | Ast.CtSig (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtSig"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_class_sig_item _loc x2) + | Ast.CtFun (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtFun"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_class_type _loc x2) + | Ast.CtCon (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtCon"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_ident _loc x2), + meta_ctyp _loc x3) + | Ast.CtNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtNil"))), + meta_acc_Loc_t _loc x0) + and meta_ctyp _loc = + function + | Ast.TyAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.TyOfAmp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyOfAmp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyAmp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAmp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyVrnInfSup (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrnInfSup"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyVrnInf (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrnInf"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyVrnSup (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrnSup"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyVrnEq (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrnEq"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TySta (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TySta"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyTup (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyTup"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyMut (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyMut"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyPrv (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyPrv"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyOr (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyOr"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyAnd (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAnd"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyOf (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyOf"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TySum (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TySum"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyCom (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyCom"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TySem (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TySem"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyCol (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyCol"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyRec (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyRec"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.TyVrn (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyVrn"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.TyQuM (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyQuM"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.TyQuP (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyQuP"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.TyQuo (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyQuo"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.TyPol (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyPol"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyOlb (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyOlb"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2) + | Ast.TyObj (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyObj"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_meta_bool _loc x2) + | Ast.TyDcl (x0, x1, x2, x3, x4) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyDcl"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_list meta_ctyp _loc x2), + meta_ctyp _loc x3), + meta_list + (fun _loc (x1, x2) -> + Ast.PaTup (_loc, + Ast.PaCom (_loc, meta_ctyp _loc x1, + meta_ctyp _loc x2))) + _loc x4) + | Ast.TyMan (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyMan"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyId (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.TyLab (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyLab"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2) + | Ast.TyCls (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyCls"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.TyArr (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyArr"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyApp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyApp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyAny x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAny"))), + meta_acc_Loc_t _loc x0) + | Ast.TyAli (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAli"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.TyNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyNil"))), + meta_acc_Loc_t _loc x0) + and meta_expr _loc = + function + | Ast.ExWhi (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExWhi"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExVrn (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExVrn"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExTyc (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExTyc"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_ctyp _loc x2) + | Ast.ExCom (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExCom"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExTup (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExTup"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExTry (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExTry"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_match_case _loc x2) + | Ast.ExStr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExStr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExSte (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExSte"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExSnd (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExSnd"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_string _loc x2) + | Ast.ExSeq (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExSeq"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExRec (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExRec"))), + meta_acc_Loc_t _loc x0), + meta_binding _loc x1), + meta_expr _loc x2) + | Ast.ExOvr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExOvr"))), + meta_acc_Loc_t _loc x0), + meta_binding _loc x1) + | Ast.ExOlb (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExOlb"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2) + | Ast.ExObj (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExObj"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_class_str_item _loc x2) + | Ast.ExNew (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExNew"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.ExMat (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExMat"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_match_case _loc x2) + | Ast.ExLmd (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExLmd"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_expr _loc x2), + meta_expr _loc x3) + | Ast.ExLet (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExLet"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_binding _loc x2), + meta_expr _loc x3) + | Ast.ExLaz (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExLaz"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExLab (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExLab"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2) + | Ast.ExNativeInt (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExNativeInt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExInt64 (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExInt64"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExInt32 (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExInt32"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExInt (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExInt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExIfe (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExIfe"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2), + meta_expr _loc x3) + | Ast.ExFun (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExFun"))), + meta_acc_Loc_t _loc x0), + meta_match_case _loc x1) + | Ast.ExFor (x0, x1, x2, x3, x4, x5) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExFor"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2), + meta_expr _loc x3), + meta_meta_bool _loc x4), + meta_expr _loc x5) + | Ast.ExFlo (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExFlo"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExCoe (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExCoe"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_ctyp _loc x2), + meta_ctyp _loc x3) + | Ast.ExChr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExChr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.ExAss (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAss"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExAsr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAsr"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExAsf x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAsf"))), + meta_acc_Loc_t _loc x0) + | Ast.ExSem (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExSem"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExArr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExArr"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.ExAre (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAre"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExApp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExApp"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.ExAcc (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAcc"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1), + meta_expr _loc x2) + | Ast.ExId (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.ExNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExNil"))), + meta_acc_Loc_t _loc x0) + and meta_ident _loc = + function + | Ast.IdAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.IdUid (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdUid"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.IdLid (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdLid"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.IdApp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdApp"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1), + meta_ident _loc x2) + | Ast.IdAcc (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdAcc"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1), + meta_ident _loc x2) + and meta_match_case _loc = + function + | Ast.McAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.McArr (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "McArr"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_expr _loc x2), + meta_expr _loc x3) + | Ast.McOr (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "McOr"))), + meta_acc_Loc_t _loc x0), + meta_match_case _loc x1), + meta_match_case _loc x2) + | Ast.McNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "McNil"))), + meta_acc_Loc_t _loc x0) + and meta_meta_bool _loc = + function + | Ast.BAnt x0 -> Ast.PaAnt (_loc, x0) + | Ast.BFalse -> + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BFalse"))) + | Ast.BTrue -> + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BTrue"))) + and meta_meta_option mf_a _loc = + function + | Ast.OAnt x0 -> Ast.PaAnt (_loc, x0) + | Ast.OSome x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "OSome"))), + mf_a _loc x0) + | Ast.ONone -> + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ONone"))) + and meta_module_binding _loc = + function + | Ast.MbAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.MbCol (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbCol"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2) + | Ast.MbColEq (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbColEq"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2), + meta_module_expr _loc x3) + | Ast.MbAnd (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbAnd"))), + meta_acc_Loc_t _loc x0), + meta_module_binding _loc x1), + meta_module_binding _loc x2) + | Ast.MbNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbNil"))), + meta_acc_Loc_t _loc x0) + and meta_module_expr _loc = + function + | Ast.MeAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.MeTyc (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeTyc"))), + meta_acc_Loc_t _loc x0), + meta_module_expr _loc x1), + meta_module_type _loc x2) + | Ast.MeStr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeStr"))), + meta_acc_Loc_t _loc x0), + meta_str_item _loc x1) + | Ast.MeFun (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeFun"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2), + meta_module_expr _loc x3) + | Ast.MeApp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeApp"))), + meta_acc_Loc_t _loc x0), + meta_module_expr _loc x1), + meta_module_expr _loc x2) + | Ast.MeId (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + and meta_module_type _loc = + function + | Ast.MtAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.MtWit (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtWit"))), + meta_acc_Loc_t _loc x0), + meta_module_type _loc x1), + meta_with_constr _loc x2) + | Ast.MtSig (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtSig"))), + meta_acc_Loc_t _loc x0), + meta_sig_item _loc x1) + | Ast.MtQuo (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtQuo"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.MtFun (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtFun"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2), + meta_module_type _loc x3) + | Ast.MtId (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + and meta_patt _loc = + function + | Ast.PaVrn (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaVrn"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaTyp (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaTyp"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.PaTyc (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaTyc"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_ctyp _loc x2) + | Ast.PaTup (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaTup"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1) + | Ast.PaStr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaStr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaEq (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaEq"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaRec (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaRec"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1) + | Ast.PaRng (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaRng"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaOrp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaOrp"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaOlbi (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaOlbi"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_patt _loc x2), + meta_expr _loc x3) + | Ast.PaOlb (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaOlb"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_patt _loc x2) + | Ast.PaLab (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaLab"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_patt _loc x2) + | Ast.PaFlo (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaFlo"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaNativeInt (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaNativeInt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaInt64 (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaInt64"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaInt32 (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaInt32"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaInt (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaInt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaChr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaChr"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1) + | Ast.PaSem (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaSem"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaCom (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaCom"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaArr (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaArr"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1) + | Ast.PaApp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaApp"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaAny x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaAny"))), + meta_acc_Loc_t _loc x0) + | Ast.PaAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.PaAli (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaAli"))), + meta_acc_Loc_t _loc x0), + meta_patt _loc x1), + meta_patt _loc x2) + | Ast.PaId (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaId"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.PaNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaNil"))), + meta_acc_Loc_t _loc x0) + and meta_sig_item _loc = + function + | Ast.SgAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.SgVal (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgVal"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2) + | Ast.SgTyp (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgTyp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.SgOpn (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgOpn"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.SgMty (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgMty"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2) + | Ast.SgRecMod (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgRecMod"))), + meta_acc_Loc_t _loc x0), + meta_module_binding _loc x1) + | Ast.SgMod (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgMod"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2) + | Ast.SgInc (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgInc"))), + meta_acc_Loc_t _loc x0), + meta_module_type _loc x1) + | Ast.SgExt (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgExt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2), + meta_string _loc x3) + | Ast.SgExc (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgExc"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.SgDir (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgDir"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2) + | Ast.SgSem (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgSem"))), + meta_acc_Loc_t _loc x0), + meta_sig_item _loc x1), + meta_sig_item _loc x2) + | Ast.SgClt (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgClt"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1) + | Ast.SgCls (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgCls"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1) + | Ast.SgNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgNil"))), + meta_acc_Loc_t _loc x0) + and meta_str_item _loc = + function + | Ast.StAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.StVal (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StVal"))), + meta_acc_Loc_t _loc x0), + meta_meta_bool _loc x1), + meta_binding _loc x2) + | Ast.StTyp (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StTyp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1) + | Ast.StOpn (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StOpn"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1) + | Ast.StMty (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StMty"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_type _loc x2) + | Ast.StRecMod (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StRecMod"))), + meta_acc_Loc_t _loc x0), + meta_module_binding _loc x1) + | Ast.StMod (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StMod"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_module_expr _loc x2) + | Ast.StInc (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StInc"))), + meta_acc_Loc_t _loc x0), + meta_module_expr _loc x1) + | Ast.StExt (x0, x1, x2, x3) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StExt"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_ctyp _loc x2), + meta_string _loc x3) + | Ast.StExp (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StExp"))), + meta_acc_Loc_t _loc x0), + meta_expr _loc x1) + | Ast.StExc (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StExc"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_meta_option meta_ident _loc x2) + | Ast.StDir (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StDir"))), + meta_acc_Loc_t _loc x0), + meta_string _loc x1), + meta_expr _loc x2) + | Ast.StSem (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StSem"))), + meta_acc_Loc_t _loc x0), + meta_str_item _loc x1), + meta_str_item _loc x2) + | Ast.StClt (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StClt"))), + meta_acc_Loc_t _loc x0), + meta_class_type _loc x1) + | Ast.StCls (x0, x1) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StCls"))), + meta_acc_Loc_t _loc x0), + meta_class_expr _loc x1) + | Ast.StNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StNil"))), + meta_acc_Loc_t _loc x0) + and meta_with_constr _loc = + function + | Ast.WcAnt (x0, x1) -> Ast.PaAnt (x0, x1) + | Ast.WcAnd (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcAnd"))), + meta_acc_Loc_t _loc x0), + meta_with_constr _loc x1), + meta_with_constr _loc x2) + | Ast.WcMod (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcMod"))), + meta_acc_Loc_t _loc x0), + meta_ident _loc x1), + meta_ident _loc x2) + | Ast.WcTyp (x0, x1, x2) -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcTyp"))), + meta_acc_Loc_t _loc x0), + meta_ctyp _loc x1), + meta_ctyp _loc x2) + | Ast.WcNil x0 -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcNil"))), + meta_acc_Loc_t _loc x0) + end + end + end + class map = + object (o) + method string = fun x -> (x : string) + method int = fun x -> (x : int) + method float = fun x -> (x : float) + method bool = fun x -> (x : bool) + method list : 'a 'b. ('a -> 'b) -> 'a list -> 'b list = List. + map + method option : 'a 'b. ('a -> 'b) -> 'a option -> 'b option = + fun f -> function | None -> None | Some x -> Some (f x) + method array : 'a 'b. ('a -> 'b) -> 'a array -> 'b array = + Array.map + method ref : 'a 'b. ('a -> 'b) -> 'a ref -> 'b ref = + fun f { contents = x } -> { contents = f x; } + method _Loc_t : Loc.t -> Loc.t = fun x -> x + method with_constr : with_constr -> with_constr = + function + | WcNil _x0 -> WcNil (o#_Loc_t _x0) + | WcTyp (_x0, _x1, _x2) -> + WcTyp (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | WcMod (_x0, _x1, _x2) -> + WcMod (o#_Loc_t _x0, o#ident _x1, o#ident _x2) + | WcAnd (_x0, _x1, _x2) -> + WcAnd (o#_Loc_t _x0, o#with_constr _x1, + o#with_constr _x2) + | WcAnt (_x0, _x1) -> WcAnt (o#_Loc_t _x0, o#string _x1) + method str_item : str_item -> str_item = + function + | StNil _x0 -> StNil (o#_Loc_t _x0) + | StCls (_x0, _x1) -> + StCls (o#_Loc_t _x0, o#class_expr _x1) + | StClt (_x0, _x1) -> + StClt (o#_Loc_t _x0, o#class_type _x1) + | StSem (_x0, _x1, _x2) -> + StSem (o#_Loc_t _x0, o#str_item _x1, o#str_item _x2) + | StDir (_x0, _x1, _x2) -> + StDir (o#_Loc_t _x0, o#string _x1, o#expr _x2) + | StExc (_x0, _x1, _x2) -> + StExc (o#_Loc_t _x0, o#ctyp _x1, + o#meta_option o#ident _x2) + | StExp (_x0, _x1) -> StExp (o#_Loc_t _x0, o#expr _x1) + | StExt (_x0, _x1, _x2, _x3) -> + StExt (o#_Loc_t _x0, o#string _x1, o#ctyp _x2, + o#string _x3) + | StInc (_x0, _x1) -> + StInc (o#_Loc_t _x0, o#module_expr _x1) + | StMod (_x0, _x1, _x2) -> + StMod (o#_Loc_t _x0, o#string _x1, o#module_expr _x2) + | StRecMod (_x0, _x1) -> + StRecMod (o#_Loc_t _x0, o#module_binding _x1) + | StMty (_x0, _x1, _x2) -> + StMty (o#_Loc_t _x0, o#string _x1, o#module_type _x2) + | StOpn (_x0, _x1) -> StOpn (o#_Loc_t _x0, o#ident _x1) + | StTyp (_x0, _x1) -> StTyp (o#_Loc_t _x0, o#ctyp _x1) + | StVal (_x0, _x1, _x2) -> + StVal (o#_Loc_t _x0, o#meta_bool _x1, o#binding _x2) + | StAnt (_x0, _x1) -> StAnt (o#_Loc_t _x0, o#string _x1) + method sig_item : sig_item -> sig_item = + function + | SgNil _x0 -> SgNil (o#_Loc_t _x0) + | SgCls (_x0, _x1) -> + SgCls (o#_Loc_t _x0, o#class_type _x1) + | SgClt (_x0, _x1) -> + SgClt (o#_Loc_t _x0, o#class_type _x1) + | SgSem (_x0, _x1, _x2) -> + SgSem (o#_Loc_t _x0, o#sig_item _x1, o#sig_item _x2) + | SgDir (_x0, _x1, _x2) -> + SgDir (o#_Loc_t _x0, o#string _x1, o#expr _x2) + | SgExc (_x0, _x1) -> SgExc (o#_Loc_t _x0, o#ctyp _x1) + | SgExt (_x0, _x1, _x2, _x3) -> + SgExt (o#_Loc_t _x0, o#string _x1, o#ctyp _x2, + o#string _x3) + | SgInc (_x0, _x1) -> + SgInc (o#_Loc_t _x0, o#module_type _x1) + | SgMod (_x0, _x1, _x2) -> + SgMod (o#_Loc_t _x0, o#string _x1, o#module_type _x2) + | SgRecMod (_x0, _x1) -> + SgRecMod (o#_Loc_t _x0, o#module_binding _x1) + | SgMty (_x0, _x1, _x2) -> + SgMty (o#_Loc_t _x0, o#string _x1, o#module_type _x2) + | SgOpn (_x0, _x1) -> SgOpn (o#_Loc_t _x0, o#ident _x1) + | SgTyp (_x0, _x1) -> SgTyp (o#_Loc_t _x0, o#ctyp _x1) + | SgVal (_x0, _x1, _x2) -> + SgVal (o#_Loc_t _x0, o#string _x1, o#ctyp _x2) + | SgAnt (_x0, _x1) -> SgAnt (o#_Loc_t _x0, o#string _x1) + method patt : patt -> patt = + function + | PaNil _x0 -> PaNil (o#_Loc_t _x0) + | PaId (_x0, _x1) -> PaId (o#_Loc_t _x0, o#ident _x1) + | PaAli (_x0, _x1, _x2) -> + PaAli (o#_Loc_t _x0, o#patt _x1, o#patt _x2) + | PaAnt (_x0, _x1) -> PaAnt (o#_Loc_t _x0, o#string _x1) + | PaAny _x0 -> PaAny (o#_Loc_t _x0) + | PaApp (_x0, _x1, _x2) -> + PaApp (o#_Loc_t _x0, o#patt _x1, o#patt _x2) + | PaArr (_x0, _x1) -> PaArr (o#_Loc_t _x0, o#patt _x1) + | PaCom (_x0, _x1, _x2) -> + PaCom (o#_Loc_t _x0, o#patt _x1, o#patt _x2) + | PaSem (_x0, _x1, _x2) -> + PaSem (o#_Loc_t _x0, o#patt _x1, o#patt _x2) + | PaChr (_x0, _x1) -> PaChr (o#_Loc_t _x0, o#string _x1) + | PaInt (_x0, _x1) -> PaInt (o#_Loc_t _x0, o#string _x1) + | PaInt32 (_x0, _x1) -> + PaInt32 (o#_Loc_t _x0, o#string _x1) + | PaInt64 (_x0, _x1) -> + PaInt64 (o#_Loc_t _x0, o#string _x1) + | PaNativeInt (_x0, _x1) -> + PaNativeInt (o#_Loc_t _x0, o#string _x1) + | PaFlo (_x0, _x1) -> PaFlo (o#_Loc_t _x0, o#string _x1) + | PaLab (_x0, _x1, _x2) -> + PaLab (o#_Loc_t _x0, o#string _x1, o#patt _x2) + | PaOlb (_x0, _x1, _x2) -> + PaOlb (o#_Loc_t _x0, o#string _x1, o#patt _x2) + | PaOlbi (_x0, _x1, _x2, _x3) -> + PaOlbi (o#_Loc_t _x0, o#string _x1, o#patt _x2, + o#expr _x3) + | PaOrp (_x0, _x1, _x2) -> + PaOrp (o#_Loc_t _x0, o#patt _x1, o#patt _x2) + | PaRng (_x0, _x1, _x2) -> + PaRng (o#_Loc_t _x0, o#patt _x1, o#patt _x2) + | PaRec (_x0, _x1) -> PaRec (o#_Loc_t _x0, o#patt _x1) + | PaEq (_x0, _x1, _x2) -> + PaEq (o#_Loc_t _x0, o#patt _x1, o#patt _x2) + | PaStr (_x0, _x1) -> PaStr (o#_Loc_t _x0, o#string _x1) + | PaTup (_x0, _x1) -> PaTup (o#_Loc_t _x0, o#patt _x1) + | PaTyc (_x0, _x1, _x2) -> + PaTyc (o#_Loc_t _x0, o#patt _x1, o#ctyp _x2) + | PaTyp (_x0, _x1) -> PaTyp (o#_Loc_t _x0, o#ident _x1) + | PaVrn (_x0, _x1) -> PaVrn (o#_Loc_t _x0, o#string _x1) + method module_type : module_type -> module_type = + function + | MtId (_x0, _x1) -> MtId (o#_Loc_t _x0, o#ident _x1) + | MtFun (_x0, _x1, _x2, _x3) -> + MtFun (o#_Loc_t _x0, o#string _x1, o#module_type _x2, + o#module_type _x3) + | MtQuo (_x0, _x1) -> MtQuo (o#_Loc_t _x0, o#string _x1) + | MtSig (_x0, _x1) -> MtSig (o#_Loc_t _x0, o#sig_item _x1) + | MtWit (_x0, _x1, _x2) -> + MtWit (o#_Loc_t _x0, o#module_type _x1, + o#with_constr _x2) + | MtAnt (_x0, _x1) -> MtAnt (o#_Loc_t _x0, o#string _x1) + method module_expr : module_expr -> module_expr = + function + | MeId (_x0, _x1) -> MeId (o#_Loc_t _x0, o#ident _x1) + | MeApp (_x0, _x1, _x2) -> + MeApp (o#_Loc_t _x0, o#module_expr _x1, + o#module_expr _x2) + | MeFun (_x0, _x1, _x2, _x3) -> + MeFun (o#_Loc_t _x0, o#string _x1, o#module_type _x2, + o#module_expr _x3) + | MeStr (_x0, _x1) -> MeStr (o#_Loc_t _x0, o#str_item _x1) + | MeTyc (_x0, _x1, _x2) -> + MeTyc (o#_Loc_t _x0, o#module_expr _x1, + o#module_type _x2) + | MeAnt (_x0, _x1) -> MeAnt (o#_Loc_t _x0, o#string _x1) + method module_binding : module_binding -> module_binding = + function + | MbNil _x0 -> MbNil (o#_Loc_t _x0) + | MbAnd (_x0, _x1, _x2) -> + MbAnd (o#_Loc_t _x0, o#module_binding _x1, + o#module_binding _x2) + | MbColEq (_x0, _x1, _x2, _x3) -> + MbColEq (o#_Loc_t _x0, o#string _x1, o#module_type _x2, + o#module_expr _x3) + | MbCol (_x0, _x1, _x2) -> + MbCol (o#_Loc_t _x0, o#string _x1, o#module_type _x2) + | MbAnt (_x0, _x1) -> MbAnt (o#_Loc_t _x0, o#string _x1) + method meta_option : + 'a 'b. ('a -> 'b) -> 'a meta_option -> 'b meta_option = + fun _f_a -> + function + | ONone -> ONone + | OSome _x0 -> OSome (_f_a _x0) + | OAnt _x0 -> OAnt (o#string _x0) + method meta_bool : meta_bool -> meta_bool = + function + | BTrue -> BTrue + | BFalse -> BFalse + | BAnt _x0 -> BAnt (o#string _x0) + method match_case : match_case -> match_case = + function + | McNil _x0 -> McNil (o#_Loc_t _x0) + | McOr (_x0, _x1, _x2) -> + McOr (o#_Loc_t _x0, o#match_case _x1, o#match_case _x2) + | McArr (_x0, _x1, _x2, _x3) -> + McArr (o#_Loc_t _x0, o#patt _x1, o#expr _x2, + o#expr _x3) + | McAnt (_x0, _x1) -> McAnt (o#_Loc_t _x0, o#string _x1) + method ident : ident -> ident = + function + | IdAcc (_x0, _x1, _x2) -> + IdAcc (o#_Loc_t _x0, o#ident _x1, o#ident _x2) + | IdApp (_x0, _x1, _x2) -> + IdApp (o#_Loc_t _x0, o#ident _x1, o#ident _x2) + | IdLid (_x0, _x1) -> IdLid (o#_Loc_t _x0, o#string _x1) + | IdUid (_x0, _x1) -> IdUid (o#_Loc_t _x0, o#string _x1) + | IdAnt (_x0, _x1) -> IdAnt (o#_Loc_t _x0, o#string _x1) + method expr : expr -> expr = + function + | ExNil _x0 -> ExNil (o#_Loc_t _x0) + | ExId (_x0, _x1) -> ExId (o#_Loc_t _x0, o#ident _x1) + | ExAcc (_x0, _x1, _x2) -> + ExAcc (o#_Loc_t _x0, o#expr _x1, o#expr _x2) + | ExAnt (_x0, _x1) -> ExAnt (o#_Loc_t _x0, o#string _x1) + | ExApp (_x0, _x1, _x2) -> + ExApp (o#_Loc_t _x0, o#expr _x1, o#expr _x2) + | ExAre (_x0, _x1, _x2) -> + ExAre (o#_Loc_t _x0, o#expr _x1, o#expr _x2) + | ExArr (_x0, _x1) -> ExArr (o#_Loc_t _x0, o#expr _x1) + | ExSem (_x0, _x1, _x2) -> + ExSem (o#_Loc_t _x0, o#expr _x1, o#expr _x2) + | ExAsf _x0 -> ExAsf (o#_Loc_t _x0) + | ExAsr (_x0, _x1) -> ExAsr (o#_Loc_t _x0, o#expr _x1) + | ExAss (_x0, _x1, _x2) -> + ExAss (o#_Loc_t _x0, o#expr _x1, o#expr _x2) + | ExChr (_x0, _x1) -> ExChr (o#_Loc_t _x0, o#string _x1) + | ExCoe (_x0, _x1, _x2, _x3) -> + ExCoe (o#_Loc_t _x0, o#expr _x1, o#ctyp _x2, + o#ctyp _x3) + | ExFlo (_x0, _x1) -> ExFlo (o#_Loc_t _x0, o#string _x1) + | ExFor (_x0, _x1, _x2, _x3, _x4, _x5) -> + ExFor (o#_Loc_t _x0, o#string _x1, o#expr _x2, + o#expr _x3, o#meta_bool _x4, o#expr _x5) + | ExFun (_x0, _x1) -> + ExFun (o#_Loc_t _x0, o#match_case _x1) + | ExIfe (_x0, _x1, _x2, _x3) -> + ExIfe (o#_Loc_t _x0, o#expr _x1, o#expr _x2, + o#expr _x3) + | ExInt (_x0, _x1) -> ExInt (o#_Loc_t _x0, o#string _x1) + | ExInt32 (_x0, _x1) -> + ExInt32 (o#_Loc_t _x0, o#string _x1) + | ExInt64 (_x0, _x1) -> + ExInt64 (o#_Loc_t _x0, o#string _x1) + | ExNativeInt (_x0, _x1) -> + ExNativeInt (o#_Loc_t _x0, o#string _x1) + | ExLab (_x0, _x1, _x2) -> + ExLab (o#_Loc_t _x0, o#string _x1, o#expr _x2) + | ExLaz (_x0, _x1) -> ExLaz (o#_Loc_t _x0, o#expr _x1) + | ExLet (_x0, _x1, _x2, _x3) -> + ExLet (o#_Loc_t _x0, o#meta_bool _x1, o#binding _x2, + o#expr _x3) + | ExLmd (_x0, _x1, _x2, _x3) -> + ExLmd (o#_Loc_t _x0, o#string _x1, o#module_expr _x2, + o#expr _x3) + | ExMat (_x0, _x1, _x2) -> + ExMat (o#_Loc_t _x0, o#expr _x1, o#match_case _x2) + | ExNew (_x0, _x1) -> ExNew (o#_Loc_t _x0, o#ident _x1) + | ExObj (_x0, _x1, _x2) -> + ExObj (o#_Loc_t _x0, o#patt _x1, o#class_str_item _x2) + | ExOlb (_x0, _x1, _x2) -> + ExOlb (o#_Loc_t _x0, o#string _x1, o#expr _x2) + | ExOvr (_x0, _x1) -> ExOvr (o#_Loc_t _x0, o#binding _x1) + | ExRec (_x0, _x1, _x2) -> + ExRec (o#_Loc_t _x0, o#binding _x1, o#expr _x2) + | ExSeq (_x0, _x1) -> ExSeq (o#_Loc_t _x0, o#expr _x1) + | ExSnd (_x0, _x1, _x2) -> + ExSnd (o#_Loc_t _x0, o#expr _x1, o#string _x2) + | ExSte (_x0, _x1, _x2) -> + ExSte (o#_Loc_t _x0, o#expr _x1, o#expr _x2) + | ExStr (_x0, _x1) -> ExStr (o#_Loc_t _x0, o#string _x1) + | ExTry (_x0, _x1, _x2) -> + ExTry (o#_Loc_t _x0, o#expr _x1, o#match_case _x2) + | ExTup (_x0, _x1) -> ExTup (o#_Loc_t _x0, o#expr _x1) + | ExCom (_x0, _x1, _x2) -> + ExCom (o#_Loc_t _x0, o#expr _x1, o#expr _x2) + | ExTyc (_x0, _x1, _x2) -> + ExTyc (o#_Loc_t _x0, o#expr _x1, o#ctyp _x2) + | ExVrn (_x0, _x1) -> ExVrn (o#_Loc_t _x0, o#string _x1) + | ExWhi (_x0, _x1, _x2) -> + ExWhi (o#_Loc_t _x0, o#expr _x1, o#expr _x2) + method ctyp : ctyp -> ctyp = + function + | TyNil _x0 -> TyNil (o#_Loc_t _x0) + | TyAli (_x0, _x1, _x2) -> + TyAli (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyAny _x0 -> TyAny (o#_Loc_t _x0) + | TyApp (_x0, _x1, _x2) -> + TyApp (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyArr (_x0, _x1, _x2) -> + TyArr (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyCls (_x0, _x1) -> TyCls (o#_Loc_t _x0, o#ident _x1) + | TyLab (_x0, _x1, _x2) -> + TyLab (o#_Loc_t _x0, o#string _x1, o#ctyp _x2) + | TyId (_x0, _x1) -> TyId (o#_Loc_t _x0, o#ident _x1) + | TyMan (_x0, _x1, _x2) -> + TyMan (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyDcl (_x0, _x1, _x2, _x3, _x4) -> + TyDcl (o#_Loc_t _x0, o#string _x1, o#list o#ctyp _x2, + o#ctyp _x3, + o#list + (fun (_x0, _x1) -> ((o#ctyp _x0), (o#ctyp _x1))) + _x4) + | TyObj (_x0, _x1, _x2) -> + TyObj (o#_Loc_t _x0, o#ctyp _x1, o#meta_bool _x2) + | TyOlb (_x0, _x1, _x2) -> + TyOlb (o#_Loc_t _x0, o#string _x1, o#ctyp _x2) + | TyPol (_x0, _x1, _x2) -> + TyPol (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyQuo (_x0, _x1) -> TyQuo (o#_Loc_t _x0, o#string _x1) + | TyQuP (_x0, _x1) -> TyQuP (o#_Loc_t _x0, o#string _x1) + | TyQuM (_x0, _x1) -> TyQuM (o#_Loc_t _x0, o#string _x1) + | TyVrn (_x0, _x1) -> TyVrn (o#_Loc_t _x0, o#string _x1) + | TyRec (_x0, _x1) -> TyRec (o#_Loc_t _x0, o#ctyp _x1) + | TyCol (_x0, _x1, _x2) -> + TyCol (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TySem (_x0, _x1, _x2) -> + TySem (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyCom (_x0, _x1, _x2) -> + TyCom (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TySum (_x0, _x1) -> TySum (o#_Loc_t _x0, o#ctyp _x1) + | TyOf (_x0, _x1, _x2) -> + TyOf (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyAnd (_x0, _x1, _x2) -> + TyAnd (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyOr (_x0, _x1, _x2) -> + TyOr (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyPrv (_x0, _x1) -> TyPrv (o#_Loc_t _x0, o#ctyp _x1) + | TyMut (_x0, _x1) -> TyMut (o#_Loc_t _x0, o#ctyp _x1) + | TyTup (_x0, _x1) -> TyTup (o#_Loc_t _x0, o#ctyp _x1) + | TySta (_x0, _x1, _x2) -> + TySta (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyVrnEq (_x0, _x1) -> TyVrnEq (o#_Loc_t _x0, o#ctyp _x1) + | TyVrnSup (_x0, _x1) -> + TyVrnSup (o#_Loc_t _x0, o#ctyp _x1) + | TyVrnInf (_x0, _x1) -> + TyVrnInf (o#_Loc_t _x0, o#ctyp _x1) + | TyVrnInfSup (_x0, _x1, _x2) -> + TyVrnInfSup (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyAmp (_x0, _x1, _x2) -> + TyAmp (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyOfAmp (_x0, _x1, _x2) -> + TyOfAmp (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | TyAnt (_x0, _x1) -> TyAnt (o#_Loc_t _x0, o#string _x1) + method class_type : class_type -> class_type = + function + | CtNil _x0 -> CtNil (o#_Loc_t _x0) + | CtCon (_x0, _x1, _x2, _x3) -> + CtCon (o#_Loc_t _x0, o#meta_bool _x1, o#ident _x2, + o#ctyp _x3) + | CtFun (_x0, _x1, _x2) -> + CtFun (o#_Loc_t _x0, o#ctyp _x1, o#class_type _x2) + | CtSig (_x0, _x1, _x2) -> + CtSig (o#_Loc_t _x0, o#ctyp _x1, o#class_sig_item _x2) + | CtAnd (_x0, _x1, _x2) -> + CtAnd (o#_Loc_t _x0, o#class_type _x1, + o#class_type _x2) + | CtCol (_x0, _x1, _x2) -> + CtCol (o#_Loc_t _x0, o#class_type _x1, + o#class_type _x2) + | CtEq (_x0, _x1, _x2) -> + CtEq (o#_Loc_t _x0, o#class_type _x1, o#class_type _x2) + | CtAnt (_x0, _x1) -> CtAnt (o#_Loc_t _x0, o#string _x1) + method class_str_item : class_str_item -> class_str_item = + function + | CrNil _x0 -> CrNil (o#_Loc_t _x0) + | CrSem (_x0, _x1, _x2) -> + CrSem (o#_Loc_t _x0, o#class_str_item _x1, + o#class_str_item _x2) + | CrCtr (_x0, _x1, _x2) -> + CrCtr (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | CrInh (_x0, _x1, _x2) -> + CrInh (o#_Loc_t _x0, o#class_expr _x1, o#string _x2) + | CrIni (_x0, _x1) -> CrIni (o#_Loc_t _x0, o#expr _x1) + | CrMth (_x0, _x1, _x2, _x3, _x4) -> + CrMth (o#_Loc_t _x0, o#string _x1, o#meta_bool _x2, + o#expr _x3, o#ctyp _x4) + | CrVal (_x0, _x1, _x2, _x3) -> + CrVal (o#_Loc_t _x0, o#string _x1, o#meta_bool _x2, + o#expr _x3) + | CrVir (_x0, _x1, _x2, _x3) -> + CrVir (o#_Loc_t _x0, o#string _x1, o#meta_bool _x2, + o#ctyp _x3) + | CrVvr (_x0, _x1, _x2, _x3) -> + CrVvr (o#_Loc_t _x0, o#string _x1, o#meta_bool _x2, + o#ctyp _x3) + | CrAnt (_x0, _x1) -> CrAnt (o#_Loc_t _x0, o#string _x1) + method class_sig_item : class_sig_item -> class_sig_item = + function + | CgNil _x0 -> CgNil (o#_Loc_t _x0) + | CgCtr (_x0, _x1, _x2) -> + CgCtr (o#_Loc_t _x0, o#ctyp _x1, o#ctyp _x2) + | CgSem (_x0, _x1, _x2) -> + CgSem (o#_Loc_t _x0, o#class_sig_item _x1, + o#class_sig_item _x2) + | CgInh (_x0, _x1) -> + CgInh (o#_Loc_t _x0, o#class_type _x1) + | CgMth (_x0, _x1, _x2, _x3) -> + CgMth (o#_Loc_t _x0, o#string _x1, o#meta_bool _x2, + o#ctyp _x3) + | CgVal (_x0, _x1, _x2, _x3, _x4) -> + CgVal (o#_Loc_t _x0, o#string _x1, o#meta_bool _x2, + o#meta_bool _x3, o#ctyp _x4) + | CgVir (_x0, _x1, _x2, _x3) -> + CgVir (o#_Loc_t _x0, o#string _x1, o#meta_bool _x2, + o#ctyp _x3) + | CgAnt (_x0, _x1) -> CgAnt (o#_Loc_t _x0, o#string _x1) + method class_expr : class_expr -> class_expr = + function + | CeNil _x0 -> CeNil (o#_Loc_t _x0) + | CeApp (_x0, _x1, _x2) -> + CeApp (o#_Loc_t _x0, o#class_expr _x1, o#expr _x2) + | CeCon (_x0, _x1, _x2, _x3) -> + CeCon (o#_Loc_t _x0, o#meta_bool _x1, o#ident _x2, + o#ctyp _x3) + | CeFun (_x0, _x1, _x2) -> + CeFun (o#_Loc_t _x0, o#patt _x1, o#class_expr _x2) + | CeLet (_x0, _x1, _x2, _x3) -> + CeLet (o#_Loc_t _x0, o#meta_bool _x1, o#binding _x2, + o#class_expr _x3) + | CeStr (_x0, _x1, _x2) -> + CeStr (o#_Loc_t _x0, o#patt _x1, o#class_str_item _x2) + | CeTyc (_x0, _x1, _x2) -> + CeTyc (o#_Loc_t _x0, o#class_expr _x1, + o#class_type _x2) + | CeAnd (_x0, _x1, _x2) -> + CeAnd (o#_Loc_t _x0, o#class_expr _x1, + o#class_expr _x2) + | CeEq (_x0, _x1, _x2) -> + CeEq (o#_Loc_t _x0, o#class_expr _x1, o#class_expr _x2) + | CeAnt (_x0, _x1) -> CeAnt (o#_Loc_t _x0, o#string _x1) + method binding : binding -> binding = + function + | BiNil _x0 -> BiNil (o#_Loc_t _x0) + | BiAnd (_x0, _x1, _x2) -> + BiAnd (o#_Loc_t _x0, o#binding _x1, o#binding _x2) + | BiSem (_x0, _x1, _x2) -> + BiSem (o#_Loc_t _x0, o#binding _x1, o#binding _x2) + | BiEq (_x0, _x1, _x2) -> + BiEq (o#_Loc_t _x0, o#patt _x1, o#expr _x2) + | BiAnt (_x0, _x1) -> BiAnt (o#_Loc_t _x0, o#string _x1) + end + class fold = + object ((o : 'self_type)) + method string = fun (_ : string) -> (o : 'self_type) + method int = fun (_ : int) -> (o : 'self_type) + method float = fun (_ : float) -> (o : 'self_type) + method bool = fun (_ : bool) -> (o : 'self_type) + method list : + 'a. + ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type = + fun f -> List.fold_left f o + method option : + 'a. + ('self_type -> 'a -> 'self_type) -> + 'a option -> 'self_type = + fun f -> function | None -> o | Some x -> f o x + method array : + 'a. + ('self_type -> 'a -> 'self_type) -> + 'a array -> 'self_type = + fun f -> Array.fold_left f o + method ref : + 'a. + ('self_type -> 'a -> 'self_type) -> 'a ref -> 'self_type = + fun f { contents = x } -> f o x + method _Loc_t : Loc.t -> 'self_type = fun _ -> o + method with_constr : with_constr -> 'self_type = + function + | WcNil _x0 -> o#_Loc_t _x0 + | WcTyp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | WcMod (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ident _x1)#ident _x2 + | WcAnd (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#with_constr _x1)#with_constr _x2 + | WcAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method str_item : str_item -> 'self_type = + function + | StNil _x0 -> o#_Loc_t _x0 + | StCls (_x0, _x1) -> (o#_Loc_t _x0)#class_expr _x1 + | StClt (_x0, _x1) -> (o#_Loc_t _x0)#class_type _x1 + | StSem (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#str_item _x1)#str_item _x2 + | StDir (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#expr _x2 + | StExc (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#meta_option + (fun o -> o#ident) _x2 + | StExp (_x0, _x1) -> (o#_Loc_t _x0)#expr _x1 + | StExt (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#ctyp _x2)#string _x3 + | StInc (_x0, _x1) -> (o#_Loc_t _x0)#module_expr _x1 + | StMod (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#module_expr _x2 + | StRecMod (_x0, _x1) -> (o#_Loc_t _x0)#module_binding _x1 + | StMty (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#module_type _x2 + | StOpn (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | StTyp (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | StVal (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#meta_bool _x1)#binding _x2 + | StAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method sig_item : sig_item -> 'self_type = + function + | SgNil _x0 -> o#_Loc_t _x0 + | SgCls (_x0, _x1) -> (o#_Loc_t _x0)#class_type _x1 + | SgClt (_x0, _x1) -> (o#_Loc_t _x0)#class_type _x1 + | SgSem (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#sig_item _x1)#sig_item _x2 + | SgDir (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#expr _x2 + | SgExc (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | SgExt (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#ctyp _x2)#string _x3 + | SgInc (_x0, _x1) -> (o#_Loc_t _x0)#module_type _x1 + | SgMod (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#module_type _x2 + | SgRecMod (_x0, _x1) -> (o#_Loc_t _x0)#module_binding _x1 + | SgMty (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#module_type _x2 + | SgOpn (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | SgTyp (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | SgVal (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#ctyp _x2 + | SgAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method patt : patt -> 'self_type = + function + | PaNil _x0 -> o#_Loc_t _x0 + | PaId (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | PaAli (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#patt _x2 + | PaAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | PaAny _x0 -> o#_Loc_t _x0 + | PaApp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#patt _x2 + | PaArr (_x0, _x1) -> (o#_Loc_t _x0)#patt _x1 + | PaCom (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#patt _x2 + | PaSem (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#patt _x2 + | PaChr (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | PaInt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | PaInt32 (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | PaInt64 (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | PaNativeInt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | PaFlo (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | PaLab (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#patt _x2 + | PaOlb (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#patt _x2 + | PaOlbi (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#patt _x2)#expr _x3 + | PaOrp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#patt _x2 + | PaRng (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#patt _x2 + | PaRec (_x0, _x1) -> (o#_Loc_t _x0)#patt _x1 + | PaEq (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#patt _x2 + | PaStr (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | PaTup (_x0, _x1) -> (o#_Loc_t _x0)#patt _x1 + | PaTyc (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#ctyp _x2 + | PaTyp (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | PaVrn (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method module_type : module_type -> 'self_type = + function + | MtId (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | MtFun (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#module_type _x2)# + module_type _x3 + | MtQuo (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | MtSig (_x0, _x1) -> (o#_Loc_t _x0)#sig_item _x1 + | MtWit (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#module_type _x1)#with_constr _x2 + | MtAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method module_expr : module_expr -> 'self_type = + function + | MeId (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | MeApp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#module_expr _x1)#module_expr _x2 + | MeFun (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#module_type _x2)# + module_expr _x3 + | MeStr (_x0, _x1) -> (o#_Loc_t _x0)#str_item _x1 + | MeTyc (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#module_expr _x1)#module_type _x2 + | MeAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method module_binding : module_binding -> 'self_type = + function + | MbNil _x0 -> o#_Loc_t _x0 + | MbAnd (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#module_binding _x1)#module_binding _x2 + | MbColEq (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#module_type _x2)# + module_expr _x3 + | MbCol (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#module_type _x2 + | MbAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method meta_option : + 'a. + ('self_type -> 'a -> 'self_type) -> + 'a meta_option -> 'self_type = + fun _f_a -> + function + | ONone -> o + | OSome _x0 -> _f_a o _x0 + | OAnt _x0 -> o#string _x0 + method meta_bool : meta_bool -> 'self_type = + function + | BTrue -> o + | BFalse -> o + | BAnt _x0 -> o#string _x0 + method match_case : match_case -> 'self_type = + function + | McNil _x0 -> o#_Loc_t _x0 + | McOr (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#match_case _x1)#match_case _x2 + | McArr (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#patt _x1)#expr _x2)#expr _x3 + | McAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method ident : ident -> 'self_type = + function + | IdAcc (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ident _x1)#ident _x2 + | IdApp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ident _x1)#ident _x2 + | IdLid (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | IdUid (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | IdAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method expr : expr -> 'self_type = + function + | ExNil _x0 -> o#_Loc_t _x0 + | ExId (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | ExAcc (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#expr _x2 + | ExAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExApp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#expr _x2 + | ExAre (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#expr _x2 + | ExArr (_x0, _x1) -> (o#_Loc_t _x0)#expr _x1 + | ExSem (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#expr _x2 + | ExAsf _x0 -> o#_Loc_t _x0 + | ExAsr (_x0, _x1) -> (o#_Loc_t _x0)#expr _x1 + | ExAss (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#expr _x2 + | ExChr (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExCoe (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#expr _x1)#ctyp _x2)#ctyp _x3 + | ExFlo (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExFor (_x0, _x1, _x2, _x3, _x4, _x5) -> + (((((o#_Loc_t _x0)#string _x1)#expr _x2)#expr _x3)# + meta_bool _x4)# + expr _x5 + | ExFun (_x0, _x1) -> (o#_Loc_t _x0)#match_case _x1 + | ExIfe (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#expr _x1)#expr _x2)#expr _x3 + | ExInt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExInt32 (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExInt64 (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExNativeInt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExLab (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#expr _x2 + | ExLaz (_x0, _x1) -> (o#_Loc_t _x0)#expr _x1 + | ExLet (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#meta_bool _x1)#binding _x2)#expr _x3 + | ExLmd (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#module_expr _x2)#expr _x3 + | ExMat (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#match_case _x2 + | ExNew (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | ExObj (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#class_str_item _x2 + | ExOlb (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#expr _x2 + | ExOvr (_x0, _x1) -> (o#_Loc_t _x0)#binding _x1 + | ExRec (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#binding _x1)#expr _x2 + | ExSeq (_x0, _x1) -> (o#_Loc_t _x0)#expr _x1 + | ExSnd (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#string _x2 + | ExSte (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#expr _x2 + | ExStr (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExTry (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#match_case _x2 + | ExTup (_x0, _x1) -> (o#_Loc_t _x0)#expr _x1 + | ExCom (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#expr _x2 + | ExTyc (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#ctyp _x2 + | ExVrn (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | ExWhi (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#expr _x1)#expr _x2 + method ctyp : ctyp -> 'self_type = + function + | TyNil _x0 -> o#_Loc_t _x0 + | TyAli (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyAny _x0 -> o#_Loc_t _x0 + | TyApp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyArr (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyCls (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | TyLab (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#ctyp _x2 + | TyId (_x0, _x1) -> (o#_Loc_t _x0)#ident _x1 + | TyMan (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyDcl (_x0, _x1, _x2, _x3, _x4) -> + ((((o#_Loc_t _x0)#string _x1)#list (fun o -> o#ctyp) + _x2)# + ctyp _x3)# + list (fun o (_x0, _x1) -> (o#ctyp _x0)#ctyp _x1) _x4 + | TyObj (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#meta_bool _x2 + | TyOlb (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#string _x1)#ctyp _x2 + | TyPol (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyQuo (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | TyQuP (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | TyQuM (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | TyVrn (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + | TyRec (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | TyCol (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TySem (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyCom (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TySum (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | TyOf (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyAnd (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyOr (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyPrv (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | TyMut (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | TyTup (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | TySta (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyVrnEq (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | TyVrnSup (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | TyVrnInf (_x0, _x1) -> (o#_Loc_t _x0)#ctyp _x1 + | TyVrnInfSup (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyAmp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyOfAmp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | TyAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method class_type : class_type -> 'self_type = + function + | CtNil _x0 -> o#_Loc_t _x0 + | CtCon (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#meta_bool _x1)#ident _x2)#ctyp _x3 + | CtFun (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#class_type _x2 + | CtSig (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#class_sig_item _x2 + | CtAnd (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_type _x1)#class_type _x2 + | CtCol (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_type _x1)#class_type _x2 + | CtEq (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_type _x1)#class_type _x2 + | CtAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method class_str_item : class_str_item -> 'self_type = + function + | CrNil _x0 -> o#_Loc_t _x0 + | CrSem (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_str_item _x1)#class_str_item _x2 + | CrCtr (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | CrInh (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_expr _x1)#string _x2 + | CrIni (_x0, _x1) -> (o#_Loc_t _x0)#expr _x1 + | CrMth (_x0, _x1, _x2, _x3, _x4) -> + ((((o#_Loc_t _x0)#string _x1)#meta_bool _x2)#expr _x3)# + ctyp _x4 + | CrVal (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#meta_bool _x2)#expr _x3 + | CrVir (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#meta_bool _x2)#ctyp _x3 + | CrVvr (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#meta_bool _x2)#ctyp _x3 + | CrAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method class_sig_item : class_sig_item -> 'self_type = + function + | CgNil _x0 -> o#_Loc_t _x0 + | CgCtr (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#ctyp _x1)#ctyp _x2 + | CgSem (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_sig_item _x1)#class_sig_item _x2 + | CgInh (_x0, _x1) -> (o#_Loc_t _x0)#class_type _x1 + | CgMth (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#meta_bool _x2)#ctyp _x3 + | CgVal (_x0, _x1, _x2, _x3, _x4) -> + ((((o#_Loc_t _x0)#string _x1)#meta_bool _x2)#meta_bool + _x3)# + ctyp _x4 + | CgVir (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#string _x1)#meta_bool _x2)#ctyp _x3 + | CgAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method class_expr : class_expr -> 'self_type = + function + | CeNil _x0 -> o#_Loc_t _x0 + | CeApp (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_expr _x1)#expr _x2 + | CeCon (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#meta_bool _x1)#ident _x2)#ctyp _x3 + | CeFun (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#class_expr _x2 + | CeLet (_x0, _x1, _x2, _x3) -> + (((o#_Loc_t _x0)#meta_bool _x1)#binding _x2)#class_expr + _x3 + | CeStr (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#class_str_item _x2 + | CeTyc (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_expr _x1)#class_type _x2 + | CeAnd (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_expr _x1)#class_expr _x2 + | CeEq (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#class_expr _x1)#class_expr _x2 + | CeAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + method binding : binding -> 'self_type = + function + | BiNil _x0 -> o#_Loc_t _x0 + | BiAnd (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#binding _x1)#binding _x2 + | BiSem (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#binding _x1)#binding _x2 + | BiEq (_x0, _x1, _x2) -> + ((o#_Loc_t _x0)#patt _x1)#expr _x2 + | BiAnt (_x0, _x1) -> (o#_Loc_t _x0)#string _x1 + end + class c_expr f = + object inherit map as super + method expr = fun x -> f (super#expr x) + end + class c_patt f = + object inherit map as super + method patt = fun x -> f (super#patt x) + end + class c_ctyp f = + object inherit map as super + method ctyp = fun x -> f (super#ctyp x) + end + class c_str_item f = + object inherit map as super + method str_item = fun x -> f (super#str_item x) + end + class c_sig_item f = + object inherit map as super + method sig_item = fun x -> f (super#sig_item x) + end + class c_loc f = + object inherit map as super + method _Loc_t = fun x -> f (super#_Loc_t x) + end + let map_patt f ast = (new c_patt f)#patt ast + let map_loc f ast = (new c_loc f)#_Loc_t ast + let map_sig_item f ast = (new c_sig_item f)#sig_item ast + let map_str_item f ast = (new c_str_item f)#str_item ast + let map_ctyp f ast = (new c_ctyp f)#ctyp ast + let map_expr f ast = (new c_expr f)#expr ast + let ghost = Loc.ghost + let rec is_module_longident = + function + | Ast.IdAcc (_, _, i) -> is_module_longident i + | Ast.IdApp (_, i1, i2) -> + (is_module_longident i1) && (is_module_longident i2) + | Ast.IdUid (_, _) -> true + | _ -> false + let rec is_irrefut_patt = + function + | Ast.PaId (_, (Ast.IdLid (_, _))) -> true + | Ast.PaId (_, (Ast.IdUid (_, "()"))) -> true + | Ast.PaAny _ -> true + | Ast.PaAli (_, x, y) -> + (is_irrefut_patt x) && (is_irrefut_patt y) + | Ast.PaRec (_, p) -> is_irrefut_patt p + | Ast.PaEq (_, (Ast.PaId (_, (Ast.IdLid (_, _)))), p) -> + is_irrefut_patt p + | Ast.PaSem (_, p1, p2) -> + (is_irrefut_patt p1) && (is_irrefut_patt p2) + | Ast.PaCom (_, p1, p2) -> + (is_irrefut_patt p1) && (is_irrefut_patt p2) + | Ast.PaTyc (_, p, _) -> is_irrefut_patt p + | Ast.PaTup (_, pl) -> is_irrefut_patt pl + | Ast.PaOlb (_, _, (Ast.PaNil _)) -> true + | Ast.PaOlb (_, _, p) -> is_irrefut_patt p + | Ast.PaOlbi (_, _, p, _) -> is_irrefut_patt p + | Ast.PaLab (_, _, (Ast.PaNil _)) -> true + | Ast.PaLab (_, _, p) -> is_irrefut_patt p + | _ -> false + let rec is_constructor = + function + | Ast.IdAcc (_, _, i) -> is_constructor i + | Ast.IdUid (_, _) -> true + | Ast.IdLid (_, _) | Ast.IdApp (_, _, _) -> false + | Ast.IdAnt (_, _) -> assert false + let is_patt_constructor = + function + | Ast.PaId (_, i) -> is_constructor i + | Ast.PaVrn (_, _) -> true + | _ -> false + let rec is_expr_constructor = + function + | Ast.ExId (_, i) -> is_constructor i + | Ast.ExAcc (_, e1, e2) -> + (is_expr_constructor e1) && (is_expr_constructor e2) + | Ast.ExVrn (_, _) -> true + | _ -> false + let ident_of_expr = + let error () = + invalid_arg + "ident_of_expr: this expression is not an identifier" in + let rec self = + function + | Ast.ExApp (_loc, e1, e2) -> + Ast.IdApp (_loc, self e1, self e2) + | Ast.ExAcc (_loc, e1, e2) -> + Ast.IdAcc (_loc, self e1, self e2) + | Ast.ExId (_, (Ast.IdLid (_, _))) -> error () + | Ast.ExId (_, i) -> + if is_module_longident i then i else error () + | _ -> error () + in + function + | Ast.ExId (_, i) -> i + | Ast.ExApp (_, _, _) -> error () + | t -> self t + let ident_of_ctyp = + let error () = + invalid_arg "ident_of_ctyp: this type is not an identifier" in + let rec self = + function + | Ast.TyApp (_loc, t1, t2) -> + Ast.IdApp (_loc, self t1, self t2) + | Ast.TyId (_, (Ast.IdLid (_, _))) -> error () + | Ast.TyId (_, i) -> + if is_module_longident i then i else error () + | _ -> error () + in function | Ast.TyId (_, i) -> i | t -> self t + let rec tyOr_of_list = + function + | [] -> Ast.TyNil ghost + | [ t ] -> t + | t :: ts -> + let _loc = loc_of_ctyp t + in Ast.TyOr (_loc, t, tyOr_of_list ts) + let rec tyAnd_of_list = + function + | [] -> Ast.TyNil ghost + | [ t ] -> t + | t :: ts -> + let _loc = loc_of_ctyp t + in Ast.TyAnd (_loc, t, tyAnd_of_list ts) + let rec tySem_of_list = + function + | [] -> Ast.TyNil ghost + | [ t ] -> t + | t :: ts -> + let _loc = loc_of_ctyp t + in Ast.TySem (_loc, t, tySem_of_list ts) + let rec stSem_of_list = + function + | [] -> Ast.StNil ghost + | [ t ] -> t + | t :: ts -> + let _loc = loc_of_str_item t + in Ast.StSem (_loc, t, stSem_of_list ts) + let rec sgSem_of_list = + function + | [] -> Ast.SgNil ghost + | [ t ] -> t + | t :: ts -> + let _loc = loc_of_sig_item t + in Ast.SgSem (_loc, t, sgSem_of_list ts) + let rec biAnd_of_list = + function + | [] -> Ast.BiNil ghost + | [ b ] -> b + | b :: bs -> + let _loc = loc_of_binding b + in Ast.BiAnd (_loc, b, biAnd_of_list bs) + let rec wcAnd_of_list = + function + | [] -> Ast.WcNil ghost + | [ w ] -> w + | w :: ws -> + let _loc = loc_of_with_constr w + in Ast.WcAnd (_loc, w, wcAnd_of_list ws) + let rec idAcc_of_list = + function + | [] -> assert false + | [ i ] -> i + | i :: is -> + let _loc = loc_of_ident i + in Ast.IdAcc (_loc, i, idAcc_of_list is) + let rec idApp_of_list = + function + | [] -> assert false + | [ i ] -> i + | i :: is -> + let _loc = loc_of_ident i + in Ast.IdApp (_loc, i, idApp_of_list is) + let rec mcOr_of_list = + function + | [] -> Ast.McNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_match_case x + in Ast.McOr (_loc, x, mcOr_of_list xs) + let rec mbAnd_of_list = + function + | [] -> Ast.MbNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_module_binding x + in Ast.MbAnd (_loc, x, mbAnd_of_list xs) + let rec meApp_of_list = + function + | [] -> assert false + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_module_expr x + in Ast.MeApp (_loc, x, meApp_of_list xs) + let rec ceAnd_of_list = + function + | [] -> Ast.CeNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_class_expr x + in Ast.CeAnd (_loc, x, ceAnd_of_list xs) + let rec ctAnd_of_list = + function + | [] -> Ast.CtNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_class_type x + in Ast.CtAnd (_loc, x, ctAnd_of_list xs) + let rec cgSem_of_list = + function + | [] -> Ast.CgNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_class_sig_item x + in Ast.CgSem (_loc, x, cgSem_of_list xs) + let rec crSem_of_list = + function + | [] -> Ast.CrNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_class_str_item x + in Ast.CrSem (_loc, x, crSem_of_list xs) + let rec paSem_of_list = + function + | [] -> Ast.PaNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_patt x + in Ast.PaSem (_loc, x, paSem_of_list xs) + let rec paCom_of_list = + function + | [] -> Ast.PaNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_patt x + in Ast.PaCom (_loc, x, paCom_of_list xs) + let rec biSem_of_list = + function + | [] -> Ast.BiNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_binding x + in Ast.BiSem (_loc, x, biSem_of_list xs) + let rec exSem_of_list = + function + | [] -> Ast.ExNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_expr x + in Ast.ExSem (_loc, x, exSem_of_list xs) + let rec exCom_of_list = + function + | [] -> Ast.ExNil ghost + | [ x ] -> x + | x :: xs -> + let _loc = loc_of_expr x + in Ast.ExCom (_loc, x, exCom_of_list xs) + let ty_of_stl = + function + | (_loc, s, []) -> Ast.TyId (_loc, Ast.IdUid (_loc, s)) + | (_loc, s, tl) -> + Ast.TyOf (_loc, Ast.TyId (_loc, Ast.IdUid (_loc, s)), + tyAnd_of_list tl) + let ty_of_sbt = + function + | (_loc, s, true, t) -> + Ast.TyCol (_loc, Ast.TyId (_loc, Ast.IdLid (_loc, s)), + Ast.TyMut (_loc, t)) + | (_loc, s, false, t) -> + Ast.TyCol (_loc, Ast.TyId (_loc, Ast.IdLid (_loc, s)), t) + let bi_of_pe (p, e) = + let _loc = loc_of_patt p in Ast.BiEq (_loc, p, e) + let sum_type_of_list l = tyOr_of_list (List.map ty_of_stl l) + let record_type_of_list l = tySem_of_list (List.map ty_of_sbt l) + let binding_of_pel l = biAnd_of_list (List.map bi_of_pe l) + let rec pel_of_binding = + function + | Ast.BiAnd (_, b1, b2) -> + (pel_of_binding b1) @ (pel_of_binding b2) + | Ast.BiEq (_, p, e) -> [ (p, e) ] + | Ast.BiSem (_, b1, b2) -> + (pel_of_binding b1) @ (pel_of_binding b2) + | _ -> assert false + let rec list_of_binding x acc = + match x with + | Ast.BiAnd (_, b1, b2) | Ast.BiSem (_, b1, b2) -> + list_of_binding b1 (list_of_binding b2 acc) + | t -> t :: acc + let rec list_of_with_constr x acc = + match x with + | Ast.WcAnd (_, w1, w2) -> + list_of_with_constr w1 (list_of_with_constr w2 acc) + | t -> t :: acc + let rec list_of_ctyp x acc = + match x with + | Ast.TyNil _ -> acc + | Ast.TyAmp (_, x, y) | Ast.TyCom (_, x, y) | + Ast.TySta (_, x, y) | Ast.TySem (_, x, y) | + Ast.TyAnd (_, x, y) | Ast.TyOr (_, x, y) -> + list_of_ctyp x (list_of_ctyp y acc) + | x -> x :: acc + let rec list_of_patt x acc = + match x with + | Ast.PaNil _ -> acc + | Ast.PaCom (_, x, y) | Ast.PaSem (_, x, y) -> + list_of_patt x (list_of_patt y acc) + | x -> x :: acc + let rec list_of_expr x acc = + match x with + | Ast.ExNil _ -> acc + | Ast.ExCom (_, x, y) | Ast.ExSem (_, x, y) -> + list_of_expr x (list_of_expr y acc) + | x -> x :: acc + let rec list_of_str_item x acc = + match x with + | Ast.StNil _ -> acc + | Ast.StSem (_, x, y) -> + list_of_str_item x (list_of_str_item y acc) + | x -> x :: acc + let rec list_of_sig_item x acc = + match x with + | Ast.SgNil _ -> acc + | Ast.SgSem (_, x, y) -> + list_of_sig_item x (list_of_sig_item y acc) + | x -> x :: acc + let rec list_of_class_sig_item x acc = + match x with + | Ast.CgNil _ -> acc + | Ast.CgSem (_, x, y) -> + list_of_class_sig_item x (list_of_class_sig_item y acc) + | x -> x :: acc + let rec list_of_class_str_item x acc = + match x with + | Ast.CrNil _ -> acc + | Ast.CrSem (_, x, y) -> + list_of_class_str_item x (list_of_class_str_item y acc) + | x -> x :: acc + let rec list_of_class_type x acc = + match x with + | Ast.CtAnd (_, x, y) -> + list_of_class_type x (list_of_class_type y acc) + | x -> x :: acc + let rec list_of_class_expr x acc = + match x with + | Ast.CeAnd (_, x, y) -> + list_of_class_expr x (list_of_class_expr y acc) + | x -> x :: acc + let rec list_of_module_expr x acc = + match x with + | Ast.MeApp (_, x, y) -> + list_of_module_expr x (list_of_module_expr y acc) + | x -> x :: acc + let rec list_of_match_case x acc = + match x with + | Ast.McNil _ -> acc + | Ast.McOr (_, x, y) -> + list_of_match_case x (list_of_match_case y acc) + | x -> x :: acc + let rec list_of_ident x acc = + match x with + | Ast.IdAcc (_, x, y) | Ast.IdApp (_, x, y) -> + list_of_ident x (list_of_ident y acc) + | x -> x :: acc + let rec list_of_module_binding x acc = + match x with + | Ast.MbAnd (_, x, y) -> + list_of_module_binding x (list_of_module_binding y acc) + | x -> x :: acc + end + end + module Quotation = + struct + module Make (Ast : Sig.Ast) : Sig.Quotation with module Ast = Ast = + struct + module Ast = Ast + module Loc = Ast.Loc + open Format + open Sig + type 'a expand_fun = Loc.t -> string option -> string -> 'a + type expander = + | ExStr of (bool -> string expand_fun) + | ExAst of Ast.expr expand_fun * Ast.patt expand_fun + let expanders_table = ref [] + let default = ref "" + let translate = ref (fun x -> x) + let expander_name name = + match !translate name with | "" -> !default | name -> name + let find name = List.assoc (expander_name name) !expanders_table + let add name f = expanders_table := (name, f) :: !expanders_table + let dump_file = ref None + module Error = + struct + type error = + | Finding | Expanding | ParsingResult of Loc.t * string + | Locating + type t = (string * error * exn) + exception E of t + let print ppf (name, ctx, exn) = + let name = if name = "" then !default else name in + let pp x = fprintf ppf "@?@[<2>While %s %S:" x name in + let () = + match ctx with + | Finding -> + (pp "finding quotation"; + fprintf ppf " available quotations are:\n@[<2>"; + List.iter (fun (s, _) -> fprintf ppf "%s@ " s) + !expanders_table; + fprintf ppf "@]") + | Expanding -> pp "expanding quotation" + | Locating -> pp "parsing" + | ParsingResult (loc, str) -> + let () = pp "parsing result of quotation" + in + (match !dump_file with + | Some dump_file -> + let () = fprintf ppf " dumping result...\n" + in + (try + let oc = open_out_bin dump_file + in + (output_string oc str; + output_string oc "\n"; + flush oc; + close_out oc; + fprintf ppf "%a:" Loc.print + (Loc.set_file_name dump_file loc)) + with + | _ -> + fprintf ppf + "Error while dumping result in file %S; dump aborted" + dump_file) + | None -> + fprintf ppf + "\n(consider setting variable Quotation.dump_file, or using the -QD option)") + in fprintf ppf "@\n%a@]@." ErrorHandler.print exn + let to_string x = + let b = Buffer.create 50 in + let () = bprintf b "%a" print x in Buffer.contents b + end + let _ = let module M = ErrorHandler.Register(Error) in () + open Error + let expand_quotation loc expander quot = + let loc_name_opt = + if quot.q_loc = "" then None else Some quot.q_loc + in + try expander loc loc_name_opt quot.q_contents + with | (Loc.Exc_located (_, (Error.E _)) as exc) -> raise exc + | Loc.Exc_located (iloc, exc) -> + let exc1 = Error.E (((quot.q_name), Expanding, exc)) + in raise (Loc.Exc_located (iloc, exc1)) + | exc -> + let exc1 = Error.E (((quot.q_name), Expanding, exc)) + in raise (Loc.Exc_located (loc, exc1)) + let parse_quotation_result parse loc quot str = + try parse loc str + with + | Loc.Exc_located (iloc, (Error.E ((n, Expanding, exc)))) -> + let ctx = ParsingResult (iloc, quot.q_contents) in + let exc1 = Error.E ((n, ctx, exc)) + in raise (Loc.Exc_located (iloc, exc1)) + | Loc.Exc_located (iloc, ((Error.E _ as exc))) -> + raise (Loc.Exc_located (iloc, exc)) + | Loc.Exc_located (iloc, exc) -> + let ctx = ParsingResult (iloc, quot.q_contents) in + let exc1 = Error.E (((quot.q_name), ctx, exc)) + in raise (Loc.Exc_located (iloc, exc1)) + let handle_quotation loc proj in_expr parse quotation = + let name = quotation.q_name in + let expander = + try find name + with | (Loc.Exc_located (_, (Error.E _)) as exc) -> raise exc + | Loc.Exc_located (qloc, exc) -> + raise + (Loc.Exc_located (qloc, Error.E ((name, Finding, exc)))) + | exc -> + raise + (Loc.Exc_located (loc, Error.E ((name, Finding, exc)))) in + let loc = Loc.join (Loc.move `start quotation.q_shift loc) + in + match expander with + | ExStr f -> + let new_str = expand_quotation loc (f in_expr) quotation + in parse_quotation_result parse loc quotation new_str + | ExAst (fe, fp) -> + expand_quotation loc (proj (fe, fp)) quotation + let expand_expr parse loc x = + handle_quotation loc fst true parse x + let expand_patt parse loc x = + handle_quotation loc snd false parse x + end + end + module AstFilters = + struct + module Make (Ast : Sig.Camlp4Ast) : + Sig.AstFilters with module Ast = Ast = + struct + module Ast = Ast + type 'a filter = 'a -> 'a + let interf_filters = Queue.create () + let fold_interf_filters f i = Queue.fold f i interf_filters + let implem_filters = Queue.create () + let fold_implem_filters f i = Queue.fold f i implem_filters + let register_sig_item_filter f = Queue.add f interf_filters + let register_str_item_filter f = Queue.add f implem_filters + end + end + module Camlp4Ast2OCamlAst : + sig + module Make (Camlp4Ast : Sig.Camlp4Ast) : + sig + open Camlp4Ast + val sig_item : sig_item -> Parsetree.signature + val str_item : str_item -> Parsetree.structure + val phrase : str_item -> Parsetree.toplevel_phrase + end + end = + struct + module Make (Ast : Sig.Camlp4Ast) = + struct + open Format + open Parsetree + open Longident + open Asttypes + open Ast + let constructors_arity () = !Camlp4_config.constructors_arity + let error loc str = Loc.raise loc (Failure str) + let char_of_char_token loc s = + try Token.Eval.char s + with | (Failure _ as exn) -> Loc.raise loc exn + let string_of_string_token loc s = + try Token.Eval.string s + with | (Failure _ as exn) -> Loc.raise loc exn + let mkloc = Loc.to_ocaml_location + let mkghloc loc = Loc.to_ocaml_location (Loc.ghostify loc) + let mktyp loc d = { ptyp_desc = d; ptyp_loc = mkloc loc; } + let mkpat loc d = { ppat_desc = d; ppat_loc = mkloc loc; } + let mkghpat loc d = { ppat_desc = d; ppat_loc = mkghloc loc; } + let mkexp loc d = { pexp_desc = d; pexp_loc = mkloc loc; } + let mkmty loc d = { pmty_desc = d; pmty_loc = mkloc loc; } + let mksig loc d = { psig_desc = d; psig_loc = mkloc loc; } + let mkmod loc d = { pmod_desc = d; pmod_loc = mkloc loc; } + let mkstr loc d = { pstr_desc = d; pstr_loc = mkloc loc; } + let mkfield loc d = { pfield_desc = d; pfield_loc = mkloc loc; } + let mkcty loc d = { pcty_desc = d; pcty_loc = mkloc loc; } + let mkpcl loc d = { pcl_desc = d; pcl_loc = mkloc loc; } + let mkpolytype t = + match t.ptyp_desc with + | Ptyp_poly (_, _) -> t + | _ -> { (t) with ptyp_desc = Ptyp_poly ([], t); } + let mb2b = + function + | Ast.BTrue -> true + | Ast.BFalse -> false + | Ast.BAnt _ -> assert false + let mkvirtual m = if mb2b m then Virtual else Concrete + let lident s = Lident s + let ldot l s = Ldot (l, s) + let lapply l s = Lapply (l, s) + let conv_con = + let t = Hashtbl.create 73 + in + (List.iter (fun (s, s') -> Hashtbl.add t s s') + [ ("True", "true"); ("False", "false"); (" True", "True"); + (" False", "False") ]; + fun s -> try Hashtbl.find t s with | Not_found -> s) + let conv_lab = + let t = Hashtbl.create 73 + in + (List.iter (fun (s, s') -> Hashtbl.add t s s') + [ ("val", "contents") ]; + fun s -> try Hashtbl.find t s with | Not_found -> s) + let array_function str name = + ldot (lident str) + (if !Camlp4_config.unsafe then "unsafe_" ^ name else name) + let mkrf = + function + | Ast.BTrue -> Recursive + | Ast.BFalse -> Nonrecursive + | Ast.BAnt _ -> assert false + let mkli s = + let rec loop f = + function + | i :: il -> loop (fun s -> ldot (f i) s) il + | [] -> f s + in loop (fun s -> lident s) + let rec ctyp_fa al = + function + | TyApp (_, f, a) -> ctyp_fa (a :: al) f + | f -> (f, al) + let ident_tag ?(conv_lid = fun x -> x) i = + let rec self i acc = + match i with + | Ast.IdAcc (_, i1, i2) -> self i2 (Some (self i1 acc)) + | Ast.IdApp (_, i1, i2) -> + let i' = + Lapply (fst (self i1 None), fst (self i2 None)) in + let x = + (match acc with + | None -> i' + | _ -> + error (loc_of_ident i) "invalid long identifier") + in (x, `app) + | Ast.IdUid (_, s) -> + let x = + (match acc with + | None -> lident s + | Some ((acc, (`uident | `app))) -> ldot acc s + | _ -> + error (loc_of_ident i) "invalid long identifier") + in (x, `uident) + | Ast.IdLid (_, s) -> + let x = + (match acc with + | None -> lident (conv_lid s) + | Some ((acc, (`uident | `app))) -> + ldot acc (conv_lid s) + | _ -> + error (loc_of_ident i) "invalid long identifier") + in (x, `lident) + | _ -> error (loc_of_ident i) "invalid long identifier" + in self i None + let ident ?conv_lid i = fst (ident_tag ?conv_lid i) + let long_lident msg i = + match ident_tag i with + | (i, `lident) -> i + | _ -> error (loc_of_ident i) msg + let long_type_ident = long_lident "invalid long identifier type" + let long_class_ident = long_lident "invalid class name" + let long_uident ?(conv_con = fun x -> x) i = + match ident_tag i with + | (Ldot (i, s), `uident) -> ldot i (conv_con s) + | (Lident s, `uident) -> lident (conv_con s) + | (i, `app) -> i + | _ -> error (loc_of_ident i) "uppercase identifier expected" + let rec ctyp_long_id_prefix t = + match t with + | Ast.TyId (_, i) -> ident i + | Ast.TyApp (_, m1, m2) -> + let li1 = ctyp_long_id_prefix m1 in + let li2 = ctyp_long_id_prefix m2 in Lapply (li1, li2) + | t -> error (loc_of_ctyp t) "invalid module expression" + let ctyp_long_id t = + match t with + | Ast.TyId (_, i) -> (false, (long_type_ident i)) + | TyApp (loc, _, _) -> error loc "invalid type name" + | TyCls (_, i) -> (true, (ident i)) + | t -> error (loc_of_ctyp t) "invalid type" + let rec ty_var_list_of_ctyp = + function + | Ast.TyApp (_, t1, t2) -> + (ty_var_list_of_ctyp t1) @ (ty_var_list_of_ctyp t2) + | Ast.TyQuo (_, s) -> [ s ] + | _ -> assert false + let rec ctyp = + function + | TyId (loc, i) -> + let li = long_type_ident i + in mktyp loc (Ptyp_constr (li, [])) + | TyAli (loc, t1, t2) -> + let (t, i) = + (match (t1, t2) with + | (t, TyQuo (_, s)) -> (t, s) + | (TyQuo (_, s), t) -> (t, s) + | _ -> error loc "invalid alias type") + in mktyp loc (Ptyp_alias (ctyp t, i)) + | TyAny loc -> mktyp loc Ptyp_any + | (TyApp (loc, _, _) as f) -> + let (f, al) = ctyp_fa [] f in + let (is_cls, li) = ctyp_long_id f + in + if is_cls + then mktyp loc (Ptyp_class (li, List.map ctyp al, [])) + else mktyp loc (Ptyp_constr (li, List.map ctyp al)) + | TyArr (loc, (TyLab (_, lab, t1)), t2) -> + mktyp loc (Ptyp_arrow (lab, ctyp t1, ctyp t2)) + | TyArr (loc, (TyOlb (loc1, lab, t1)), t2) -> + let t1 = + TyApp (loc1, Ast.TyId (loc1, Ast.IdLid (loc1, "option")), + t1) + in mktyp loc (Ptyp_arrow ("?" ^ lab, ctyp t1, ctyp t2)) + | TyArr (loc, t1, t2) -> + mktyp loc (Ptyp_arrow ("", ctyp t1, ctyp t2)) + | Ast.TyObj (loc, (Ast.TyNil _), Ast.BFalse) -> + mktyp loc (Ptyp_object []) + | Ast.TyObj (loc, (Ast.TyNil _), Ast.BTrue) -> + mktyp loc (Ptyp_object [ mkfield loc Pfield_var ]) + | Ast.TyObj (loc, fl, Ast.BFalse) -> + mktyp loc (Ptyp_object (meth_list fl [])) + | Ast.TyObj (loc, fl, Ast.BTrue) -> + mktyp loc + (Ptyp_object (meth_list fl [ mkfield loc Pfield_var ])) + | TyCls (loc, id) -> mktyp loc (Ptyp_class (ident id, [], [])) + | TyLab (loc, _, _) -> + error loc "labelled type not allowed here" + | TyMan (loc, _, _) -> + error loc "manifest type not allowed here" + | TyOlb (loc, _, _) -> + error loc "labelled type not allowed here" + | TyPol (loc, t1, t2) -> + mktyp loc (Ptyp_poly (ty_var_list_of_ctyp t1, ctyp t2)) + | TyQuo (loc, s) -> mktyp loc (Ptyp_var s) + | TyRec (loc, _) -> error loc "record type not allowed here" + | TySum (loc, _) -> error loc "sum type not allowed here" + | TyPrv (loc, _) -> error loc "private type not allowed here" + | TyMut (loc, _) -> error loc "mutable type not allowed here" + | TyOr (loc, _, _) -> + error loc "type1 | type2 not allowed here" + | TyAnd (loc, _, _) -> + error loc "type1 and type2 not allowed here" + | TyOf (loc, _, _) -> + error loc "type1 of type2 not allowed here" + | TyCol (loc, _, _) -> + error loc "type1 : type2 not allowed here" + | TySem (loc, _, _) -> + error loc "type1 ; type2 not allowed here" + | Ast.TyTup (loc, (Ast.TySta (_, t1, t2))) -> + mktyp loc + (Ptyp_tuple + (List.map ctyp (list_of_ctyp t1 (list_of_ctyp t2 [])))) + | Ast.TyVrnEq (loc, t) -> + mktyp loc (Ptyp_variant (row_field t, true, None)) + | Ast.TyVrnSup (loc, t) -> + mktyp loc (Ptyp_variant (row_field t, false, None)) + | Ast.TyVrnInf (loc, t) -> + mktyp loc (Ptyp_variant (row_field t, true, Some [])) + | Ast.TyVrnInfSup (loc, t, t') -> + mktyp loc + (Ptyp_variant (row_field t, true, Some (name_tags t'))) + | TyAnt (loc, _) -> error loc "antiquotation not allowed here" + | TyOfAmp (_, _, _) | TyAmp (_, _, _) | TySta (_, _, _) | + TyCom (_, _, _) | TyVrn (_, _) | TyQuM (_, _) | + TyQuP (_, _) | TyDcl (_, _, _, _, _) | + TyObj (_, _, (BAnt _)) | TyNil _ | TyTup (_, _) -> + assert false + and row_field = + function + | Ast.TyVrn (_, i) -> [ Rtag (i, true, []) ] + | Ast.TyOfAmp (_, (Ast.TyVrn (_, i)), t) -> + [ Rtag (i, true, List.map ctyp (list_of_ctyp t [])) ] + | Ast.TyOf (_, (Ast.TyVrn (_, i)), t) -> + [ Rtag (i, false, List.map ctyp (list_of_ctyp t [])) ] + | Ast.TyOr (_, t1, t2) -> (row_field t1) @ (row_field t2) + | t -> [ Rinherit (ctyp t) ] + and name_tags = + function + | Ast.TyApp (_, t1, t2) -> (name_tags t1) @ (name_tags t2) + | Ast.TyVrn (_, s) -> [ s ] + | _ -> assert false + and meth_list fl acc = + match fl with + | Ast.TySem (_, t1, t2) -> meth_list t1 (meth_list t2 acc) + | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (_, lab)))), t) -> + (mkfield loc (Pfield (lab, mkpolytype (ctyp t)))) :: acc + | _ -> assert false + let mktype loc tl cl tk tm = + let (params, variance) = List.split tl + in + { + + ptype_params = params; + ptype_cstrs = cl; + ptype_kind = tk; + ptype_manifest = tm; + ptype_loc = mkloc loc; + ptype_variance = variance; + } + let mkprivate' m = if m then Private else Public + let mkprivate m = mkprivate' (mb2b m) + let mktrecord = + function + | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (_, s)))), + (Ast.TyMut (_, t))) -> + (s, Mutable, (mkpolytype (ctyp t)), (mkloc loc)) + | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (_, s)))), t) -> + (s, Immutable, (mkpolytype (ctyp t)), (mkloc loc)) + | _ -> assert false + let mkvariant = + function + | Ast.TyId (loc, (Ast.IdUid (_, s))) -> + ((conv_con s), [], (mkloc loc)) + | Ast.TyOf (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), t) -> + ((conv_con s), (List.map ctyp (list_of_ctyp t [])), + (mkloc loc)) + | _ -> assert false + let rec type_decl tl cl loc m pflag = + function + | TyMan (_, t1, t2) -> + type_decl tl cl loc (Some (ctyp t1)) pflag t2 + | TyPrv (_, t) -> type_decl tl cl loc m true t + | TyRec (_, t) -> + mktype loc tl cl + (Ptype_record (List.map mktrecord (list_of_ctyp t []), + mkprivate' pflag)) + m + | TySum (_, t) -> + mktype loc tl cl + (Ptype_variant (List.map mkvariant (list_of_ctyp t []), + mkprivate' pflag)) + m + | t -> + if m <> None + then + error loc "only one manifest type allowed by definition" + else + (let m = + match t with + | TyQuo (_, s) -> + if List.mem_assoc s tl + then Some (ctyp t) + else None + | _ -> Some (ctyp t) in + let k = if pflag then Ptype_private else Ptype_abstract + in mktype loc tl cl k m) + let type_decl tl cl t = + type_decl tl cl (loc_of_ctyp t) None false t + let mkvalue_desc t p = { pval_type = ctyp t; pval_prim = p; } + let mkmutable m = if mb2b m then Mutable else Immutable + let paolab lab p = + match (lab, p) with + | ("", + (Ast.PaId (_, (Ast.IdLid (_, i))) | + Ast.PaTyc (_, (Ast.PaId (_, (Ast.IdLid (_, i)))), _))) + -> i + | ("", p) -> error (loc_of_patt p) "bad ast in label" + | _ -> lab + let opt_private_ctyp = + function + | Ast.TyPrv (_, t) -> (Ptype_private, (ctyp t)) + | t -> (Ptype_abstract, (ctyp t)) + let rec type_parameters t acc = + match t with + | Ast.TyApp (_, t1, t2) -> + type_parameters t1 (type_parameters t2 acc) + | Ast.TyQuP (_, s) -> (s, (true, false)) :: acc + | Ast.TyQuM (_, s) -> (s, (false, true)) :: acc + | Ast.TyQuo (_, s) -> (s, (false, false)) :: acc + | _ -> assert false + let rec class_parameters t acc = + match t with + | Ast.TyCom (_, t1, t2) -> + class_parameters t1 (class_parameters t2 acc) + | Ast.TyQuP (_, s) -> (s, (true, false)) :: acc + | Ast.TyQuM (_, s) -> (s, (false, true)) :: acc + | Ast.TyQuo (_, s) -> (s, (false, false)) :: acc + | _ -> assert false + let rec type_parameters_and_type_name t acc = + match t with + | Ast.TyApp (_, t1, t2) -> + type_parameters_and_type_name t1 (type_parameters t2 acc) + | Ast.TyId (_, i) -> ((ident i), acc) + | _ -> assert false + let rec mkwithc wc acc = + match wc with + | WcNil _ -> acc + | WcTyp (loc, id_tpl, ct) -> + let (id, tpl) = type_parameters_and_type_name id_tpl [] in + let (params, variance) = List.split tpl in + let (kind, ct) = opt_private_ctyp ct + in + (id, + (Pwith_type + { + + ptype_params = params; + ptype_cstrs = []; + ptype_kind = kind; + ptype_manifest = Some ct; + ptype_loc = mkloc loc; + ptype_variance = variance; + })) :: + acc + | WcMod (_, i1, i2) -> + ((long_uident i1), (Pwith_module (long_uident i2))) :: acc + | Ast.WcAnd (_, wc1, wc2) -> mkwithc wc1 (mkwithc wc2 acc) + | Ast.WcAnt (loc, _) -> + error loc "bad with constraint (antiquotation)" + let rec patt_fa al = + function + | PaApp (_, f, a) -> patt_fa (a :: al) f + | f -> (f, al) + let rec deep_mkrangepat loc c1 c2 = + if c1 = c2 + then mkghpat loc (Ppat_constant (Const_char c1)) + else + mkghpat loc + (Ppat_or (mkghpat loc (Ppat_constant (Const_char c1)), + deep_mkrangepat loc (Char.chr ((Char.code c1) + 1)) c2)) + let rec mkrangepat loc c1 c2 = + if c1 > c2 + then mkrangepat loc c2 c1 + else + if c1 = c2 + then mkpat loc (Ppat_constant (Const_char c1)) + else + mkpat loc + (Ppat_or (mkghpat loc (Ppat_constant (Const_char c1)), + deep_mkrangepat loc (Char.chr ((Char.code c1) + 1)) c2)) + let rec patt = + function + | Ast.PaId (loc, (Ast.IdLid (_, s))) -> mkpat loc (Ppat_var s) + | Ast.PaId (loc, i) -> + let p = + Ppat_construct (long_uident ~conv_con i, None, + constructors_arity ()) + in mkpat loc p + | PaAli (loc, p1, p2) -> + let (p, i) = + (match (p1, p2) with + | (p, Ast.PaId (_, (Ast.IdLid (_, s)))) -> (p, s) + | (Ast.PaId (_, (Ast.IdLid (_, s))), p) -> (p, s) + | _ -> error loc "invalid alias pattern") + in mkpat loc (Ppat_alias (patt p, i)) + | PaAnt (loc, _) -> error loc "antiquotation not allowed here" + | PaAny loc -> mkpat loc Ppat_any + | Ast.PaApp (loc, (Ast.PaId (_, (Ast.IdUid (_, s)))), + (Ast.PaTup (_, (Ast.PaAny loc_any)))) -> + mkpat loc + (Ppat_construct (lident (conv_con s), + Some (mkpat loc_any Ppat_any), false)) + | (PaApp (loc, _, _) as f) -> + let (f, al) = patt_fa [] f in + let al = List.map patt al + in + (match (patt f).ppat_desc with + | Ppat_construct (li, None, _) -> + if constructors_arity () + then + mkpat loc + (Ppat_construct (li, + Some (mkpat loc (Ppat_tuple al)), true)) + else + (let a = + match al with + | [ a ] -> a + | _ -> mkpat loc (Ppat_tuple al) + in mkpat loc (Ppat_construct (li, Some a, false))) + | Ppat_variant (s, None) -> + let a = + if constructors_arity () + then mkpat loc (Ppat_tuple al) + else + (match al with + | [ a ] -> a + | _ -> mkpat loc (Ppat_tuple al)) + in mkpat loc (Ppat_variant (s, Some a)) + | _ -> + error (loc_of_patt f) + "this is not a constructor, it cannot be applied in a pattern") + | PaArr (loc, p) -> + mkpat loc (Ppat_array (List.map patt (list_of_patt p []))) + | PaChr (loc, s) -> + mkpat loc + (Ppat_constant (Const_char (char_of_char_token loc s))) + | PaInt (loc, s) -> + let i = + (try int_of_string s + with + | Failure _ -> + error loc + "Integer literal exceeds the range of representable integers of type int") + in mkpat loc (Ppat_constant (Const_int i)) + | PaInt32 (loc, s) -> + let i32 = + (try Int32.of_string s + with + | Failure _ -> + error loc + "Integer literal exceeds the range of representable integers of type int32") + in mkpat loc (Ppat_constant (Const_int32 i32)) + | PaInt64 (loc, s) -> + let i64 = + (try Int64.of_string s + with + | Failure _ -> + error loc + "Integer literal exceeds the range of representable integers of type int64") + in mkpat loc (Ppat_constant (Const_int64 i64)) + | PaNativeInt (loc, s) -> + let nati = + (try Nativeint.of_string s + with + | Failure _ -> + error loc + "Integer literal exceeds the range of representable integers of type nativeint") + in mkpat loc (Ppat_constant (Const_nativeint nati)) + | PaFlo (loc, s) -> mkpat loc (Ppat_constant (Const_float s)) + | PaLab (loc, _, _) -> + error loc "labeled pattern not allowed here" + | PaOlb (loc, _, _) | PaOlbi (loc, _, _, _) -> + error loc "labeled pattern not allowed here" + | PaOrp (loc, p1, p2) -> mkpat loc (Ppat_or (patt p1, patt p2)) + | PaRng (loc, p1, p2) -> + (match (p1, p2) with + | (PaChr (loc1, c1), PaChr (loc2, c2)) -> + let c1 = char_of_char_token loc1 c1 in + let c2 = char_of_char_token loc2 c2 + in mkrangepat loc c1 c2 + | _ -> + error loc "range pattern allowed only for characters") + | PaRec (loc, p) -> + mkpat loc + (Ppat_record (List.map mklabpat (list_of_patt p []))) + | PaStr (loc, s) -> + mkpat loc + (Ppat_constant + (Const_string (string_of_string_token loc s))) + | Ast.PaTup (loc, (Ast.PaCom (_, p1, p2))) -> + mkpat loc + (Ppat_tuple + (List.map patt (list_of_patt p1 (list_of_patt p2 [])))) + | Ast.PaTup (loc, _) -> error loc "singleton tuple pattern" + | PaTyc (loc, p, t) -> + mkpat loc (Ppat_constraint (patt p, ctyp t)) + | PaTyp (loc, i) -> mkpat loc (Ppat_type (long_type_ident i)) + | PaVrn (loc, s) -> mkpat loc (Ppat_variant (s, None)) + | (PaEq (_, _, _) | PaSem (_, _, _) | PaCom (_, _, _) | PaNil _ + as p) -> error (loc_of_patt p) "invalid pattern" + and mklabpat = + function + | Ast.PaEq (_, (Ast.PaId (_, i)), p) -> + ((ident ~conv_lid: conv_lab i), (patt p)) + | p -> error (loc_of_patt p) "invalid pattern" + let rec expr_fa al = + function + | ExApp (_, f, a) -> expr_fa (a :: al) f + | f -> (f, al) + let rec class_expr_fa al = + function + | CeApp (_, ce, a) -> class_expr_fa (a :: al) ce + | ce -> (ce, al) + let rec sep_expr_acc l = + function + | ExAcc (_, e1, e2) -> sep_expr_acc (sep_expr_acc l e2) e1 + | (Ast.ExId (loc, (Ast.IdUid (_, s))) as e) -> + (match l with + | [] -> [ (loc, [], e) ] + | (loc', sl, e) :: l -> + ((Loc.merge loc loc'), (s :: sl), e) :: l) + | Ast.ExId (_, ((Ast.IdAcc (_, _, _) as i))) -> + let rec normalize_acc = + (function + | Ast.IdAcc (_loc, i1, i2) -> + Ast.ExAcc (_loc, normalize_acc i1, normalize_acc i2) + | Ast.IdApp (_loc, i1, i2) -> + Ast.ExApp (_loc, normalize_acc i1, normalize_acc i2) + | (Ast.IdAnt (_loc, _) | Ast.IdUid (_loc, _) | + Ast.IdLid (_loc, _) + as i) -> Ast.ExId (_loc, i)) + in sep_expr_acc l (normalize_acc i) + | e -> ((loc_of_expr e), [], e) :: l + let list_of_opt_ctyp ot acc = + match ot with | Ast.TyNil _ -> acc | t -> list_of_ctyp t acc + let rec expr = + function + | Ast.ExAcc (loc, x, (Ast.ExId (_, (Ast.IdLid (_, "val"))))) -> + mkexp loc + (Pexp_apply (mkexp loc (Pexp_ident (Lident "!")), + [ ("", (expr x)) ])) + | (ExAcc (loc, _, _) | Ast.ExId (loc, (Ast.IdAcc (_, _, _))) as + e) -> + let (e, l) = + (match sep_expr_acc [] e with + | (loc, ml, Ast.ExId (_, (Ast.IdUid (_, s)))) :: l -> + let ca = constructors_arity () + in + ((mkexp loc (Pexp_construct (mkli s ml, None, ca))), + l) + | (loc, ml, Ast.ExId (_, (Ast.IdLid (_, s)))) :: l -> + ((mkexp loc (Pexp_ident (mkli s ml))), l) + | (_, [], e) :: l -> ((expr e), l) + | _ -> error loc "bad ast in expression") in + let (_, e) = + List.fold_left + (fun (loc_bp, e1) (loc_ep, ml, e2) -> + match e2 with + | Ast.ExId (_, (Ast.IdLid (_, s))) -> + let loc = Loc.merge loc_bp loc_ep + in + (loc, + (mkexp loc + (Pexp_field (e1, mkli (conv_lab s) ml)))) + | _ -> + error (loc_of_expr e2) + "lowercase identifier expected") + (loc, e) l + in e + | ExAnt (loc, _) -> error loc "antiquotation not allowed here" + | (ExApp (loc, _, _) as f) -> + let (f, al) = expr_fa [] f in + let al = List.map label_expr al + in + (match (expr f).pexp_desc with + | Pexp_construct (li, None, _) -> + let al = List.map snd al + in + if constructors_arity () + then + mkexp loc + (Pexp_construct (li, + Some (mkexp loc (Pexp_tuple al)), true)) + else + (let a = + match al with + | [ a ] -> a + | _ -> mkexp loc (Pexp_tuple al) + in + mkexp loc + (Pexp_construct (li, Some a, false))) + | Pexp_variant (s, None) -> + let al = List.map snd al in + let a = + if constructors_arity () + then mkexp loc (Pexp_tuple al) + else + (match al with + | [ a ] -> a + | _ -> mkexp loc (Pexp_tuple al)) + in mkexp loc (Pexp_variant (s, Some a)) + | _ -> mkexp loc (Pexp_apply (expr f, al))) + | ExAre (loc, e1, e2) -> + mkexp loc + (Pexp_apply + (mkexp loc (Pexp_ident (array_function "Array" "get")), + [ ("", (expr e1)); ("", (expr e2)) ])) + | ExArr (loc, e) -> + mkexp loc (Pexp_array (List.map expr (list_of_expr e []))) + | ExAsf loc -> mkexp loc Pexp_assertfalse + | ExAss (loc, e, v) -> + let e = + (match e with + | Ast.ExAcc (loc, x, + (Ast.ExId (_, (Ast.IdLid (_, "val"))))) -> + Pexp_apply (mkexp loc (Pexp_ident (Lident ":=")), + [ ("", (expr x)); ("", (expr v)) ]) + | ExAcc (loc, _, _) -> + (match (expr e).pexp_desc with + | Pexp_field (e, lab) -> + Pexp_setfield (e, lab, expr v) + | _ -> error loc "bad record access") + | ExAre (_, e1, e2) -> + Pexp_apply + (mkexp loc + (Pexp_ident (array_function "Array" "set")), + [ ("", (expr e1)); ("", (expr e2)); ("", (expr v)) ]) + | Ast.ExId (_, (Ast.IdLid (_, lab))) -> + Pexp_setinstvar (lab, expr v) + | ExSte (_, e1, e2) -> + Pexp_apply + (mkexp loc + (Pexp_ident (array_function "String" "set")), + [ ("", (expr e1)); ("", (expr e2)); ("", (expr v)) ]) + | _ -> error loc "bad left part of assignment") + in mkexp loc e + | ExAsr (loc, e) -> mkexp loc (Pexp_assert (expr e)) + | ExChr (loc, s) -> + mkexp loc + (Pexp_constant (Const_char (char_of_char_token loc s))) + | ExCoe (loc, e, t1, t2) -> + let t1 = + (match t1 with | Ast.TyNil _ -> None | t -> Some (ctyp t)) + in mkexp loc (Pexp_constraint (expr e, t1, Some (ctyp t2))) + | ExFlo (loc, s) -> mkexp loc (Pexp_constant (Const_float s)) + | ExFor (loc, i, e1, e2, df, el) -> + let e3 = ExSeq (loc, el) in + let df = if mb2b df then Upto else Downto + in mkexp loc (Pexp_for (i, expr e1, expr e2, df, expr e3)) + | Ast.ExFun (loc, (Ast.McArr (_, (PaLab (_, lab, po)), w, e))) + -> + mkexp loc + (Pexp_function (lab, None, + [ ((patt_of_lab loc lab po), (when_expr e w)) ])) + | Ast.ExFun (loc, + (Ast.McArr (_, (PaOlbi (_, lab, p, e1)), w, e2))) -> + let lab = paolab lab p + in + mkexp loc + (Pexp_function ("?" ^ lab, Some (expr e1), + [ ((patt p), (when_expr e2 w)) ])) + | Ast.ExFun (loc, (Ast.McArr (_, (PaOlb (_, lab, p)), w, e))) + -> + let lab = paolab lab p + in + mkexp loc + (Pexp_function ("?" ^ lab, None, + [ ((patt_of_lab loc lab p), (when_expr e w)) ])) + | ExFun (loc, a) -> + mkexp loc (Pexp_function ("", None, match_case a [])) + | ExIfe (loc, e1, e2, e3) -> + mkexp loc + (Pexp_ifthenelse (expr e1, expr e2, Some (expr e3))) + | ExInt (loc, s) -> + let i = + (try int_of_string s + with + | Failure _ -> + error loc + "Integer literal exceeds the range of representable integers of type int") + in mkexp loc (Pexp_constant (Const_int i)) + | ExInt32 (loc, s) -> + let i32 = + (try Int32.of_string s + with + | Failure _ -> + error loc + "Integer literal exceeds the range of representable integers of type int32") + in mkexp loc (Pexp_constant (Const_int32 i32)) + | ExInt64 (loc, s) -> + let i64 = + (try Int64.of_string s + with + | Failure _ -> + error loc + "Integer literal exceeds the range of representable integers of type int64") + in mkexp loc (Pexp_constant (Const_int64 i64)) + | ExNativeInt (loc, s) -> + let nati = + (try Nativeint.of_string s + with + | Failure _ -> + error loc + "Integer literal exceeds the range of representable integers of type nativeint") + in mkexp loc (Pexp_constant (Const_nativeint nati)) + | ExLab (loc, _, _) -> + error loc "labeled expression not allowed here" + | ExLaz (loc, e) -> mkexp loc (Pexp_lazy (expr e)) + | ExLet (loc, rf, bi, e) -> + mkexp loc (Pexp_let (mkrf rf, binding bi [], expr e)) + | ExLmd (loc, i, me, e) -> + mkexp loc (Pexp_letmodule (i, module_expr me, expr e)) + | ExMat (loc, e, a) -> + mkexp loc (Pexp_match (expr e, match_case a [])) + | ExNew (loc, id) -> mkexp loc (Pexp_new (long_type_ident id)) + | ExObj (loc, po, cfl) -> + let p = + (match po with | Ast.PaNil _ -> Ast.PaAny loc | p -> p) in + let cil = class_str_item cfl [] + in mkexp loc (Pexp_object (((patt p), cil))) + | ExOlb (loc, _, _) -> + error loc "labeled expression not allowed here" + | ExOvr (loc, iel) -> + mkexp loc (Pexp_override (mkideexp iel [])) + | ExRec (loc, lel, eo) -> + (match lel with + | Ast.BiNil _ -> error loc "empty record" + | _ -> + let eo = + (match eo with + | Ast.ExNil _ -> None + | e -> Some (expr e)) + in mkexp loc (Pexp_record (mklabexp lel [], eo))) + | ExSeq (_loc, e) -> + let rec loop = + (function + | [] -> expr (Ast.ExId (_loc, Ast.IdUid (_loc, "()"))) + | [ e ] -> expr e + | e :: el -> + let _loc = Loc.merge (loc_of_expr e) _loc + in mkexp _loc (Pexp_sequence (expr e, loop el))) + in loop (list_of_expr e []) + | ExSnd (loc, e, s) -> mkexp loc (Pexp_send (expr e, s)) + | ExSte (loc, e1, e2) -> + mkexp loc + (Pexp_apply + (mkexp loc + (Pexp_ident (array_function "String" "get")), + [ ("", (expr e1)); ("", (expr e2)) ])) + | ExStr (loc, s) -> + mkexp loc + (Pexp_constant + (Const_string (string_of_string_token loc s))) + | ExTry (loc, e, a) -> + mkexp loc (Pexp_try (expr e, match_case a [])) + | Ast.ExTup (loc, (Ast.ExCom (_, e1, e2))) -> + mkexp loc + (Pexp_tuple + (List.map expr (list_of_expr e1 (list_of_expr e2 [])))) + | Ast.ExTup (loc, _) -> error loc "singleton tuple" + | ExTyc (loc, e, t) -> + mkexp loc (Pexp_constraint (expr e, Some (ctyp t), None)) + | Ast.ExId (loc, (Ast.IdUid (_, "()"))) -> + mkexp loc (Pexp_construct (lident "()", None, true)) + | Ast.ExId (loc, (Ast.IdLid (_, s))) -> + mkexp loc (Pexp_ident (lident s)) + | Ast.ExId (loc, (Ast.IdUid (_, s))) -> + mkexp loc + (Pexp_construct (lident (conv_con s), None, true)) + | ExVrn (loc, s) -> mkexp loc (Pexp_variant (s, None)) + | ExWhi (loc, e1, el) -> + let e2 = ExSeq (loc, el) + in mkexp loc (Pexp_while (expr e1, expr e2)) + | Ast.ExCom (loc, _, _) -> + error loc "expr, expr: not allowed here" + | Ast.ExSem (loc, _, _) -> + error loc + "expr; expr: not allowed here, use do {...} or [|...|] to surround them" + | (ExId (_, _) | ExNil _ as e) -> + error (loc_of_expr e) "invalid expr" + and patt_of_lab _loc lab = + function + | Ast.PaNil _ -> patt (Ast.PaId (_loc, Ast.IdLid (_loc, lab))) + | p -> patt p + and expr_of_lab _loc lab = + function + | Ast.ExNil _ -> expr (Ast.ExId (_loc, Ast.IdLid (_loc, lab))) + | e -> expr e + and label_expr = + function + | ExLab (loc, lab, eo) -> (lab, (expr_of_lab loc lab eo)) + | ExOlb (loc, lab, eo) -> + (("?" ^ lab), (expr_of_lab loc lab eo)) + | e -> ("", (expr e)) + and binding x acc = + match x with + | Ast.BiAnd (_, x, y) | Ast.BiSem (_, x, y) -> + binding x (binding y acc) + | Ast.BiEq (_, p, e) -> ((patt p), (expr e)) :: acc + | Ast.BiNil _ -> acc + | _ -> assert false + and match_case x acc = + match x with + | Ast.McOr (_, x, y) -> match_case x (match_case y acc) + | Ast.McArr (_, p, w, e) -> ((patt p), (when_expr e w)) :: acc + | Ast.McNil _ -> acc + | _ -> assert false + and when_expr e w = + match w with + | Ast.ExNil _ -> expr e + | w -> mkexp (loc_of_expr w) (Pexp_when (expr w, expr e)) + and mklabexp x acc = + match x with + | Ast.BiAnd (_, x, y) | Ast.BiSem (_, x, y) -> + mklabexp x (mklabexp y acc) + | Ast.BiEq (_, (Ast.PaId (_, i)), e) -> + ((ident ~conv_lid: conv_lab i), (expr e)) :: acc + | _ -> assert false + and mkideexp x acc = + match x with + | Ast.BiAnd (_, x, y) | Ast.BiSem (_, x, y) -> + mkideexp x (mkideexp y acc) + | Ast.BiEq (_, (Ast.PaId (_, (Ast.IdLid (_, s)))), e) -> + (s, (expr e)) :: acc + | _ -> assert false + and mktype_decl x acc = + match x with + | Ast.TyAnd (_, x, y) -> mktype_decl x (mktype_decl y acc) + | Ast.TyDcl (_, c, tl, td, cl) -> + let cl = + List.map + (fun (t1, t2) -> + let loc = + Loc.merge (loc_of_ctyp t1) (loc_of_ctyp t2) + in ((ctyp t1), (ctyp t2), (mkloc loc))) + cl + in + (c, + (type_decl (List.fold_right type_parameters tl []) cl td)) :: + acc + | _ -> assert false + and module_type = + function + | MtId (loc, i) -> mkmty loc (Pmty_ident (long_uident i)) + | MtFun (loc, n, nt, mt) -> + mkmty loc + (Pmty_functor (n, module_type nt, module_type mt)) + | MtQuo (loc, _) -> + error loc "abstract module type not allowed here" + | MtSig (loc, sl) -> + mkmty loc (Pmty_signature (sig_item sl [])) + | MtWit (loc, mt, wc) -> + mkmty loc (Pmty_with (module_type mt, mkwithc wc [])) + | Ast.MtAnt (_, _) -> assert false + and sig_item s l = + match s with + | Ast.SgNil _ -> l + | SgCls (loc, cd) -> + (mksig loc + (Psig_class + (List.map class_info_class_type + (list_of_class_type cd [])))) :: + l + | SgClt (loc, ctd) -> + (mksig loc + (Psig_class_type + (List.map class_info_class_type + (list_of_class_type ctd [])))) :: + l + | Ast.SgSem (_, sg1, sg2) -> sig_item sg1 (sig_item sg2 l) + | SgDir (_, _, _) -> l + | Ast.SgExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s))))) -> + (mksig loc (Psig_exception (conv_con s, []))) :: l + | Ast.SgExc (loc, + (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t))) -> + (mksig loc + (Psig_exception (conv_con s, + List.map ctyp (list_of_ctyp t [])))) :: + l + | SgExc (_, _) -> assert false + | SgExt (loc, n, t, p) -> + (mksig loc (Psig_value (n, mkvalue_desc t [ p ]))) :: l + | SgInc (loc, mt) -> + (mksig loc (Psig_include (module_type mt))) :: l + | SgMod (loc, n, mt) -> + (mksig loc (Psig_module (n, module_type mt))) :: l + | SgRecMod (loc, mb) -> + (mksig loc (Psig_recmodule (module_sig_binding mb []))) :: + l + | SgMty (loc, n, mt) -> + let si = + (match mt with + | MtQuo (_, _) -> Pmodtype_abstract + | _ -> Pmodtype_manifest (module_type mt)) + in (mksig loc (Psig_modtype (n, si))) :: l + | SgOpn (loc, id) -> + (mksig loc (Psig_open (long_uident id))) :: l + | SgTyp (loc, tdl) -> + (mksig loc (Psig_type (mktype_decl tdl []))) :: l + | SgVal (loc, n, t) -> + (mksig loc (Psig_value (n, mkvalue_desc t []))) :: l + | Ast.SgAnt (loc, _) -> error loc "antiquotation in sig_item" + and module_sig_binding x acc = + match x with + | Ast.MbAnd (_, x, y) -> + module_sig_binding x (module_sig_binding y acc) + | Ast.MbCol (_, s, mt) -> (s, (module_type mt)) :: acc + | _ -> assert false + and module_str_binding x acc = + match x with + | Ast.MbAnd (_, x, y) -> + module_str_binding x (module_str_binding y acc) + | Ast.MbColEq (_, s, mt, me) -> + (s, (module_type mt), (module_expr me)) :: acc + | _ -> assert false + and module_expr = + function + | MeId (loc, i) -> mkmod loc (Pmod_ident (long_uident i)) + | MeApp (loc, me1, me2) -> + mkmod loc (Pmod_apply (module_expr me1, module_expr me2)) + | MeFun (loc, n, mt, me) -> + mkmod loc + (Pmod_functor (n, module_type mt, module_expr me)) + | MeStr (loc, sl) -> + mkmod loc (Pmod_structure (str_item sl [])) + | MeTyc (loc, me, mt) -> + mkmod loc + (Pmod_constraint (module_expr me, module_type mt)) + | Ast.MeAnt (loc, _) -> + error loc "antiquotation in module_expr" + and str_item s l = + match s with + | Ast.StNil _ -> l + | StCls (loc, cd) -> + (mkstr loc + (Pstr_class + (List.map class_info_class_expr + (list_of_class_expr cd [])))) :: + l + | StClt (loc, ctd) -> + (mkstr loc + (Pstr_class_type + (List.map class_info_class_type + (list_of_class_type ctd [])))) :: + l + | Ast.StSem (_, st1, st2) -> str_item st1 (str_item st2 l) + | StDir (_, _, _) -> l + | Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), Ast. + ONone) -> + (mkstr loc (Pstr_exception (conv_con s, []))) :: l + | Ast.StExc (loc, + (Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t)), Ast. + ONone) -> + (mkstr loc + (Pstr_exception (conv_con s, + List.map ctyp (list_of_ctyp t [])))) :: + l + | Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), + (Ast.OSome i)) -> + (mkstr loc (Pstr_exn_rebind (conv_con s, ident i))) :: l + | StExc (_, _, _) -> assert false + | StExp (loc, e) -> (mkstr loc (Pstr_eval (expr e))) :: l + | StExt (loc, n, t, p) -> + (mkstr loc (Pstr_primitive (n, mkvalue_desc t [ p ]))) :: l + | StInc (loc, me) -> + (mkstr loc (Pstr_include (module_expr me))) :: l + | StMod (loc, n, me) -> + (mkstr loc (Pstr_module (n, module_expr me))) :: l + | StRecMod (loc, mb) -> + (mkstr loc (Pstr_recmodule (module_str_binding mb []))) :: + l + | StMty (loc, n, mt) -> + (mkstr loc (Pstr_modtype (n, module_type mt))) :: l + | StOpn (loc, id) -> + (mkstr loc (Pstr_open (long_uident id))) :: l + | StTyp (loc, tdl) -> + (mkstr loc (Pstr_type (mktype_decl tdl []))) :: l + | StVal (loc, rf, bi) -> + (mkstr loc (Pstr_value (mkrf rf, binding bi []))) :: l + | Ast.StAnt (loc, _) -> error loc "antiquotation in str_item" + and class_type = + function + | CtCon (loc, Ast.BFalse, id, tl) -> + mkcty loc + (Pcty_constr (long_class_ident id, + List.map ctyp (list_of_opt_ctyp tl []))) + | CtFun (loc, (TyLab (_, lab, t)), ct) -> + mkcty loc (Pcty_fun (lab, ctyp t, class_type ct)) + | CtFun (loc, (TyOlb (loc1, lab, t)), ct) -> + let t = + TyApp (loc1, Ast.TyId (loc1, Ast.IdLid (loc1, "option")), + t) + in mkcty loc (Pcty_fun ("?" ^ lab, ctyp t, class_type ct)) + | CtFun (loc, t, ct) -> + mkcty loc (Pcty_fun ("", ctyp t, class_type ct)) + | CtSig (loc, t_o, ctfl) -> + let t = + (match t_o with | Ast.TyNil _ -> Ast.TyAny loc | t -> t) in + let cil = class_sig_item ctfl [] + in mkcty loc (Pcty_signature (((ctyp t), cil))) + | CtCon (loc, _, _, _) -> + error loc "invalid virtual class inside a class type" + | CtAnt (_, _) | CtEq (_, _, _) | CtCol (_, _, _) | + CtAnd (_, _, _) | CtNil _ -> assert false + and class_info_class_expr ci = + match ci with + | CeEq (_, (CeCon (loc, vir, (IdLid (_, name)), params)), ce) + -> + let (loc_params, (params, variance)) = + (match params with + | Ast.TyNil _ -> (loc, ([], [])) + | t -> + ((loc_of_ctyp t), + (List.split (class_parameters t [])))) + in + { + + pci_virt = if mb2b vir then Virtual else Concrete; + pci_params = (params, (mkloc loc_params)); + pci_name = name; + pci_expr = class_expr ce; + pci_loc = mkloc loc; + pci_variance = variance; + } + | ce -> error (loc_of_class_expr ce) "bad class definition" + and class_info_class_type ci = + match ci with + | CtEq (_, (CtCon (loc, vir, (IdLid (_, name)), params)), ct) | + CtCol (_, (CtCon (loc, vir, (IdLid (_, name)), params)), + ct) + -> + let (loc_params, (params, variance)) = + (match params with + | Ast.TyNil _ -> (loc, ([], [])) + | t -> + ((loc_of_ctyp t), + (List.split (class_parameters t [])))) + in + { + + pci_virt = if mb2b vir then Virtual else Concrete; + pci_params = (params, (mkloc loc_params)); + pci_name = name; + pci_expr = class_type ct; + pci_loc = mkloc loc; + pci_variance = variance; + } + | ct -> + error (loc_of_class_type ct) + "bad class/class type declaration/definition" + and class_sig_item c l = + match c with + | Ast.CgNil _ -> l + | CgCtr (loc, t1, t2) -> + (Pctf_cstr (((ctyp t1), (ctyp t2), (mkloc loc)))) :: l + | Ast.CgSem (_, csg1, csg2) -> + class_sig_item csg1 (class_sig_item csg2 l) + | CgInh (_, ct) -> (Pctf_inher (class_type ct)) :: l + | CgMth (loc, s, pf, t) -> + (Pctf_meth + ((s, (mkprivate pf), (mkpolytype (ctyp t)), (mkloc loc)))) :: + l + | CgVal (loc, s, b, v, t) -> + (Pctf_val + ((s, (mkmutable b), (mkvirtual v), (ctyp t), + (mkloc loc)))) :: + l + | CgVir (loc, s, b, t) -> + (Pctf_virt + ((s, (mkprivate b), (mkpolytype (ctyp t)), (mkloc loc)))) :: + l + | CgAnt (_, _) -> assert false + and class_expr = + function + | (CeApp (loc, _, _) as c) -> + let (ce, el) = class_expr_fa [] c in + let el = List.map label_expr el + in mkpcl loc (Pcl_apply (class_expr ce, el)) + | CeCon (loc, Ast.BFalse, id, tl) -> + mkpcl loc + (Pcl_constr (long_class_ident id, + List.map ctyp (list_of_opt_ctyp tl []))) + | CeFun (loc, (PaLab (_, lab, po)), ce) -> + mkpcl loc + (Pcl_fun (lab, None, patt_of_lab loc lab po, + class_expr ce)) + | CeFun (loc, (PaOlbi (_, lab, p, e)), ce) -> + let lab = paolab lab p + in + mkpcl loc + (Pcl_fun ("?" ^ lab, Some (expr e), patt p, + class_expr ce)) + | CeFun (loc, (PaOlb (_, lab, p)), ce) -> + let lab = paolab lab p + in + mkpcl loc + (Pcl_fun ("?" ^ lab, None, patt_of_lab loc lab p, + class_expr ce)) + | CeFun (loc, p, ce) -> + mkpcl loc (Pcl_fun ("", None, patt p, class_expr ce)) + | CeLet (loc, rf, bi, ce) -> + mkpcl loc (Pcl_let (mkrf rf, binding bi [], class_expr ce)) + | CeStr (loc, po, cfl) -> + let p = + (match po with | Ast.PaNil _ -> Ast.PaAny loc | p -> p) in + let cil = class_str_item cfl [] + in mkpcl loc (Pcl_structure (((patt p), cil))) + | CeTyc (loc, ce, ct) -> + mkpcl loc (Pcl_constraint (class_expr ce, class_type ct)) + | CeCon (loc, _, _, _) -> + error loc "invalid virtual class inside a class expression" + | CeAnt (_, _) | CeEq (_, _, _) | CeAnd (_, _, _) | CeNil _ -> + assert false + and class_str_item c l = + match c with + | CrNil _ -> l + | CrCtr (loc, t1, t2) -> + (Pcf_cstr (((ctyp t1), (ctyp t2), (mkloc loc)))) :: l + | Ast.CrSem (_, cst1, cst2) -> + class_str_item cst1 (class_str_item cst2 l) + | CrInh (_, ce, "") -> (Pcf_inher (class_expr ce, None)) :: l + | CrInh (_, ce, pb) -> + (Pcf_inher (class_expr ce, Some pb)) :: l + | CrIni (_, e) -> (Pcf_init (expr e)) :: l + | CrMth (loc, s, b, e, t) -> + let t = + (match t with + | Ast.TyNil _ -> None + | t -> Some (mkpolytype (ctyp t))) in + let e = mkexp loc (Pexp_poly (expr e, t)) + in (Pcf_meth ((s, (mkprivate b), e, (mkloc loc)))) :: l + | CrVal (loc, s, b, e) -> + (Pcf_val ((s, (mkmutable b), (expr e), (mkloc loc)))) :: l + | CrVir (loc, s, b, t) -> + (Pcf_virt + ((s, (mkprivate b), (mkpolytype (ctyp t)), (mkloc loc)))) :: + l + | CrVvr (loc, s, b, t) -> + (Pcf_valvirt ((s, (mkmutable b), (ctyp t), (mkloc loc)))) :: + l + | CrAnt (_, _) -> assert false + let sig_item ast = sig_item ast [] + let str_item ast = str_item ast [] + let directive = + function + | Ast.ExNil _ -> Pdir_none + | ExStr (_, s) -> Pdir_string s + | ExInt (_, i) -> Pdir_int (int_of_string i) + | Ast.ExId (_, (Ast.IdUid (_, "True"))) -> Pdir_bool true + | Ast.ExId (_, (Ast.IdUid (_, "False"))) -> Pdir_bool false + | e -> Pdir_ident (ident (ident_of_expr e)) + let phrase = + function + | StDir (_, d, dp) -> Ptop_dir (d, directive dp) + | si -> Ptop_def (str_item si) + end + end + module CleanAst = + struct + module Make (Ast : Sig.Camlp4Ast) = + struct + class clean_ast = + object (self) + inherit Ast.map as super + method with_constr = + function + | Ast.WcAnd (_, (Ast.WcNil _), wc) | + Ast.WcAnd (_, wc, (Ast.WcNil _)) -> self#with_constr wc + | wc -> super#with_constr wc + method expr = + function + | Ast.ExLet (_, _, (Ast.BiNil _), e) | + Ast.ExRec (_, (Ast.BiNil _), e) | + Ast.ExCom (_, (Ast.ExNil _), e) | + Ast.ExCom (_, e, (Ast.ExNil _)) | + Ast.ExSem (_, (Ast.ExNil _), e) | + Ast.ExSem (_, e, (Ast.ExNil _)) -> self#expr e + | e -> super#expr e + method patt = + function + | Ast.PaAli (_, p, (Ast.PaNil _)) | + Ast.PaOrp (_, (Ast.PaNil _), p) | + Ast.PaOrp (_, p, (Ast.PaNil _)) | + Ast.PaCom (_, (Ast.PaNil _), p) | + Ast.PaCom (_, p, (Ast.PaNil _)) | + Ast.PaSem (_, (Ast.PaNil _), p) | + Ast.PaSem (_, p, (Ast.PaNil _)) -> self#patt p + | p -> super#patt p + method match_case = + function + | Ast.McOr (_, (Ast.McNil _), mc) | + Ast.McOr (_, mc, (Ast.McNil _)) -> self#match_case mc + | mc -> super#match_case mc + method binding = + function + | Ast.BiAnd (_, (Ast.BiNil _), bi) | + Ast.BiAnd (_, bi, (Ast.BiNil _)) | + Ast.BiSem (_, (Ast.BiNil _), bi) | + Ast.BiSem (_, bi, (Ast.BiNil _)) -> self#binding bi + | bi -> super#binding bi + method module_binding = + function + | Ast.MbAnd (_, (Ast.MbNil _), mb) | + Ast.MbAnd (_, mb, (Ast.MbNil _)) -> + self#module_binding mb + | mb -> super#module_binding mb + method ctyp = + function + | Ast.TyPol (_, (Ast.TyNil _), t) | + Ast.TyAli (_, (Ast.TyNil _), t) | + Ast.TyAli (_, t, (Ast.TyNil _)) | + Ast.TyArr (_, t, (Ast.TyNil _)) | + Ast.TyArr (_, (Ast.TyNil _), t) | + Ast.TyOr (_, (Ast.TyNil _), t) | + Ast.TyOr (_, t, (Ast.TyNil _)) | + Ast.TyOf (_, t, (Ast.TyNil _)) | + Ast.TyAnd (_, (Ast.TyNil _), t) | + Ast.TyAnd (_, t, (Ast.TyNil _)) | + Ast.TySem (_, t, (Ast.TyNil _)) | + Ast.TySem (_, (Ast.TyNil _), t) | + Ast.TyCom (_, (Ast.TyNil _), t) | + Ast.TyCom (_, t, (Ast.TyNil _)) | + Ast.TyAmp (_, t, (Ast.TyNil _)) | + Ast.TyAmp (_, (Ast.TyNil _), t) | + Ast.TySta (_, (Ast.TyNil _), t) | + Ast.TySta (_, t, (Ast.TyNil _)) -> self#ctyp t + | t -> super#ctyp t + method sig_item = + function + | Ast.SgSem (_, (Ast.SgNil _), sg) | + Ast.SgSem (_, sg, (Ast.SgNil _)) -> self#sig_item sg + | sg -> super#sig_item sg + method str_item = + function + | Ast.StSem (_, (Ast.StNil _), st) | + Ast.StSem (_, st, (Ast.StNil _)) -> self#str_item st + | st -> super#str_item st + method module_type = + function + | Ast.MtWit (_, mt, (Ast.WcNil _)) -> self#module_type mt + | mt -> super#module_type mt + method class_expr = + function + | Ast.CeAnd (_, (Ast.CeNil _), ce) | + Ast.CeAnd (_, ce, (Ast.CeNil _)) -> self#class_expr ce + | ce -> super#class_expr ce + method class_type = + function + | Ast.CtAnd (_, (Ast.CtNil _), ct) | + Ast.CtAnd (_, ct, (Ast.CtNil _)) -> self#class_type ct + | ct -> super#class_type ct + method class_sig_item = + function + | Ast.CgSem (_, (Ast.CgNil _), csg) | + Ast.CgSem (_, csg, (Ast.CgNil _)) -> + self#class_sig_item csg + | csg -> super#class_sig_item csg + method class_str_item = + function + | Ast.CrSem (_, (Ast.CrNil _), cst) | + Ast.CrSem (_, cst, (Ast.CrNil _)) -> + self#class_str_item cst + | cst -> super#class_str_item cst + end + end + end + module CommentFilter : + sig + module Make (Token : Sig.Camlp4Token) : + sig + open Token + type t + val mk : unit -> t + val define : Token.Filter.t -> t -> unit + val filter : + t -> (Token.t * Loc.t) Stream.t -> (Token.t * Loc.t) Stream.t + val take_list : t -> (string * Loc.t) list + val take_stream : t -> (string * Loc.t) Stream.t + end + end = + struct + module Make (Token : Sig.Camlp4Token) = + struct + open Token + type t = + (((string * Loc.t) Stream.t) * ((string * Loc.t) Queue.t)) + let mk () = + let q = Queue.create () in + let f _ = try Some (Queue.take q) with | Queue.Empty -> None + in ((Stream.from f), q) + let filter (_, q) = + let rec self (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some ((Sig.COMMENT x, loc)) -> + (Stream.junk __strm; + let xs = __strm in (Queue.add (x, loc) q; self xs)) + | Some x -> + (Stream.junk __strm; + let xs = __strm + in Stream.icons x (Stream.slazy (fun _ -> self xs))) + | _ -> Stream.sempty + in self + let take_list (_, q) = + let rec self accu = + if Queue.is_empty q + then accu + else self ((Queue.take q) :: accu) + in self [] + let take_stream = fst + let define token_fiter comments_strm = + Token.Filter.define_filter token_fiter + (fun previous strm -> previous (filter comments_strm strm)) + end + end + module DynLoader : sig include Sig.DynLoader end = + struct + type t = string Queue.t + exception Error of string * string + let include_dir x y = Queue.add y x + let fold_load_path x f acc = Queue.fold (fun x y -> f y x) acc x + let mk ?(ocaml_stdlib = true) ?(camlp4_stdlib = true) () = + let q = Queue.create () + in + (if ocaml_stdlib + then include_dir q Camlp4_config.ocaml_standard_library + else (); + if camlp4_stdlib + then + (include_dir q Camlp4_config.camlp4_standard_library; + include_dir q + (Filename.concat Camlp4_config.camlp4_standard_library + "Camlp4Parsers"); + include_dir q + (Filename.concat Camlp4_config.camlp4_standard_library + "Camlp4Printers"); + include_dir q + (Filename.concat Camlp4_config.camlp4_standard_library + "Camlp4Filters")) + else (); + include_dir q "."; + q) + let find_in_path x name = + if not (Filename.is_implicit name) + then if Sys.file_exists name then name else raise Not_found + else + (let res = + fold_load_path x + (fun dir -> + function + | None -> + let fullname = Filename.concat dir name + in + if Sys.file_exists fullname + then Some fullname + else None + | x -> x) + None + in match res with | None -> raise Not_found | Some x -> x) + let load = + let _initialized = ref false + in + fun _path file -> + raise + (Error (file, "native-code program cannot do a dynamic load")) + end + module EmptyError : sig include Sig.Error end = + struct + type t = unit + exception E of t + let print _ = assert false + let to_string _ = assert false + end + module EmptyPrinter : + sig module Make (Ast : Sig.Ast) : Sig.Printer with module Ast = Ast end = + struct + module Make (Ast : Sig.Ast) = + struct + module Ast = Ast + let print_interf ?input_file:(_) ?output_file:(_) _ = + failwith "No interface printer" + let print_implem ?input_file:(_) ?output_file:(_) _ = + failwith "No implementation printer" + end + end + module FreeVars : + sig + module Make (Ast : Sig.Camlp4Ast) : + sig + module S : Set.S with type elt = string + val fold_binding_vars : + (string -> 'accu -> 'accu) -> Ast.binding -> 'accu -> 'accu + class ['accu] c_fold_pattern_vars : + (string -> 'accu -> 'accu) -> + 'accu -> + object inherit Ast.fold val acc : 'accu method acc : 'accu + end + val fold_pattern_vars : + (string -> 'accu -> 'accu) -> Ast.patt -> 'accu -> 'accu + class ['accu] fold_free_vars : + (string -> 'accu -> 'accu) -> + ?env_init: S.t -> + 'accu -> + object ('self_type) + inherit Ast.fold + val free : 'accu + val env : S.t + method free : 'accu + method set_env : S.t -> 'self_type + method add_atom : string -> 'self_type + method add_patt : Ast.patt -> 'self_type + method add_binding : Ast.binding -> 'self_type + end + val free_vars : S.t -> Ast.expr -> S.t + end + end = + struct + module Make (Ast : Sig.Camlp4Ast) = + struct + module S = Set.Make(String) + let rec fold_binding_vars f bi acc = + match bi with + | Ast.BiAnd (_, bi1, bi2) | Ast.BiSem (_, bi1, bi2) -> + fold_binding_vars f bi1 (fold_binding_vars f bi2 acc) + | Ast.BiEq (_, (Ast.PaId (_, (Ast.IdLid (_, i)))), _) -> + f i acc + | _ -> assert false + class ['accu] c_fold_pattern_vars f init = + object (o) + inherit Ast.fold as super + val acc = init + method acc : 'accu = acc + method patt = + function + | Ast.PaId (_, (Ast.IdLid (_, s))) | + Ast.PaLab (_, s, (Ast.PaNil _)) | + Ast.PaOlb (_, s, (Ast.PaNil _)) -> + {< acc = f s acc; >} + | Ast.PaEq (_, (Ast.PaId (_, (Ast.IdLid (_, _)))), p) -> + o#patt p + | p -> super#patt p + end + let fold_pattern_vars f p init = + ((new c_fold_pattern_vars f init)#patt p)#acc + class ['accu] fold_free_vars (f : string -> 'accu -> 'accu) + ?(env_init = S.empty) free_init = + object (o) + inherit Ast.fold as super + val free = (free_init : 'accu) + val env = (env_init : S.t) + method free = free + method set_env = fun env -> {< env = env; >} + method add_atom = fun s -> {< env = S.add s env; >} + method add_patt = + fun p -> {< env = fold_pattern_vars S.add p env; >} + method add_binding = + fun bi -> {< env = fold_binding_vars S.add bi env; >} + method expr = + function + | Ast.ExId (_, (Ast.IdLid (_, s))) | + Ast.ExLab (_, s, (Ast.ExNil _)) | + Ast.ExOlb (_, s, (Ast.ExNil _)) -> + if S.mem s env then o else {< free = f s free; >} + | Ast.ExLet (_, Ast.BFalse, bi, e) -> + (((o#add_binding bi)#expr e)#set_env env)#binding bi + | Ast.ExLet (_, Ast.BTrue, bi, e) -> + (((o#add_binding bi)#expr e)#binding bi)#set_env env + | Ast.ExFor (_, s, e1, e2, _, e3) -> + ((((o#expr e1)#expr e2)#add_atom s)#expr e3)#set_env + env + | Ast.ExId (_, _) | Ast.ExNew (_, _) -> o + | Ast.ExObj (_, p, cst) -> + ((o#add_patt p)#class_str_item cst)#set_env env + | e -> super#expr e + method match_case = + function + | Ast.McArr (_, p, e1, e2) -> + (((o#add_patt p)#expr e1)#expr e2)#set_env env + | m -> super#match_case m + method str_item = + function + | Ast.StExt (_, s, t, _) -> (o#ctyp t)#add_atom s + | Ast.StVal (_, Ast.BFalse, bi) -> + (o#binding bi)#add_binding bi + | Ast.StVal (_, Ast.BTrue, bi) -> + (o#add_binding bi)#binding bi + | st -> super#str_item st + method class_expr = + function + | Ast.CeFun (_, p, ce) -> + ((o#add_patt p)#class_expr ce)#set_env env + | Ast.CeLet (_, Ast.BFalse, bi, ce) -> + (((o#binding bi)#add_binding bi)#class_expr ce)#set_env + env + | Ast.CeLet (_, Ast.BTrue, bi, ce) -> + (((o#add_binding bi)#binding bi)#class_expr ce)#set_env + env + | Ast.CeStr (_, p, cst) -> + ((o#add_patt p)#class_str_item cst)#set_env env + | ce -> super#class_expr ce + method class_str_item = + function + | (Ast.CrInh (_, _, "") as cst) -> super#class_str_item cst + | Ast.CrInh (_, ce, s) -> (o#class_expr ce)#add_atom s + | Ast.CrVal (_, s, _, e) -> (o#expr e)#add_atom s + | Ast.CrVvr (_, s, _, t) -> (o#ctyp t)#add_atom s + | cst -> super#class_str_item cst + method module_expr = + function + | Ast.MeStr (_, st) -> (o#str_item st)#set_env env + | me -> super#module_expr me + end + let free_vars env_init e = + let fold = new fold_free_vars S.add ~env_init S.empty + in (fold#expr e)#free + end + end + module Grammar = + struct + module Context = + struct + module type S = + sig + module Token : Sig.Token + open Token + type t + val call_with_ctx : + (Token.t * Loc.t) Stream.t -> (t -> 'a) -> 'a + val loc_bp : t -> Loc.t + val loc_ep : t -> Loc.t + val stream : t -> (Token.t * Loc.t) Stream.t + val peek_nth : t -> int -> (Token.t * Loc.t) option + val njunk : t -> int -> unit + val junk : (Token.t * Loc.t) Stream.t -> unit + val bp : (Token.t * Loc.t) Stream.t -> Loc.t + end + module Make (Token : Sig.Token) : S with module Token = Token = + struct + module Token = Token + open Token + type t = + { mutable strm : (Token.t * Loc.t) Stream.t; + mutable loc : Loc.t + } + let loc_bp c = + match Stream.peek c.strm with + | None -> Loc.ghost + | Some ((_, loc)) -> loc + let loc_ep c = c.loc + let set_loc c = + match Stream.peek c.strm with + | Some ((_, loc)) -> c.loc <- loc + | None -> () + let mk strm = + match Stream.peek strm with + | Some ((_, loc)) -> { strm = strm; loc = loc; } + | None -> { strm = strm; loc = Loc.ghost; } + let stream c = c.strm + let peek_nth c n = + let list = Stream.npeek n c.strm in + let rec loop list n = + match (list, n) with + | ((((_, loc) as x)) :: _, 1) -> (c.loc <- loc; Some x) + | (_ :: l, n) -> loop l (n - 1) + | ([], _) -> None + in loop list n + let njunk c n = + (for i = 1 to n do Stream.junk c.strm done; set_loc c) + let streams = ref [] + let mk strm = + let c = mk strm in + let () = streams := (strm, c) :: !streams in c + let junk strm = + (set_loc (List.assq strm !streams); Stream.junk strm) + let bp strm = loc_bp (List.assq strm !streams) + let call_with_ctx strm f = + let streams_v = !streams in + let r = + try f (mk strm) + with | exc -> (streams := streams_v; raise exc) + in (streams := streams_v; r) + end + end + module Structure = + struct + open Sig.Grammar + module type S = + sig + module Loc : Sig.Loc + module Token : Sig.Token with module Loc = Loc + module Lexer : Sig.Lexer with module Loc = Loc + and module Token = Token + module Context : Context.S with module Token = Token + module Action : Sig.Grammar.Action + type gram = + { gfilter : Token.Filter.t; + gkeywords : (string, int ref) Hashtbl.t; + glexer : + Loc.t -> char Stream.t -> (Token.t * Loc.t) Stream.t; + warning_verbose : bool ref; error_verbose : bool ref + } + type efun = + Context.t -> (Token.t * Loc.t) Stream.t -> Action.t + type token_pattern = ((Token.t -> bool) * string) + type internal_entry = + { egram : gram; ename : string; + mutable estart : int -> efun; + mutable econtinue : int -> Loc.t -> Action.t -> efun; + mutable edesc : desc + } + and desc = + | Dlevels of level list + | Dparser of ((Token.t * Loc.t) Stream.t -> Action.t) + and level = + { assoc : assoc; lname : string option; lsuffix : tree; + lprefix : tree + } + and symbol = + | Smeta of string * symbol list * Action.t + | Snterm of internal_entry + | Snterml of internal_entry * string | Slist0 of symbol + | Slist0sep of symbol * symbol | Slist1 of symbol + | Slist1sep of symbol * symbol | Sopt of symbol | Sself + | Snext | Stoken of token_pattern | Skeyword of string + | Stree of tree + and tree = + | Node of node | LocAct of Action.t * Action.t list + | DeadEnd + and node = + { node : symbol; son : tree; brother : tree + } + type production_rule = ((symbol list) * Action.t) + type single_extend_statment = + ((string option) * (assoc option) * (production_rule list)) + type extend_statment = + ((position option) * (single_extend_statment list)) + type delete_statment = symbol list + type ('a, 'b, 'c) fold = + internal_entry -> + symbol list -> ('a Stream.t -> 'b) -> 'a Stream.t -> 'c + type ('a, 'b, 'c) foldsep = + internal_entry -> + symbol list -> + ('a Stream.t -> 'b) -> + ('a Stream.t -> unit) -> 'a Stream.t -> 'c + val get_filter : gram -> Token.Filter.t + val using : gram -> string -> unit + val removing : gram -> string -> unit + end + module Make (Lexer : Sig.Lexer) = + struct + module Loc = Lexer.Loc + module Token = Lexer.Token + module Action : Sig.Grammar.Action = + struct + type t = Obj.t + let mk = Obj.repr + let get = Obj.obj + let getf = Obj.obj + let getf2 = Obj.obj + end + module Lexer = Lexer + type gram = + { gfilter : Token.Filter.t; + gkeywords : (string, int ref) Hashtbl.t; + glexer : + Loc.t -> char Stream.t -> (Token.t * Loc.t) Stream.t; + warning_verbose : bool ref; error_verbose : bool ref + } + module Context = Context.Make(Token) + type efun = + Context.t -> (Token.t * Loc.t) Stream.t -> Action.t + type token_pattern = ((Token.t -> bool) * string) + type internal_entry = + { egram : gram; ename : string; + mutable estart : int -> efun; + mutable econtinue : int -> Loc.t -> Action.t -> efun; + mutable edesc : desc + } + and desc = + | Dlevels of level list + | Dparser of ((Token.t * Loc.t) Stream.t -> Action.t) + and level = + { assoc : assoc; lname : string option; lsuffix : tree; + lprefix : tree + } + and symbol = + | Smeta of string * symbol list * Action.t + | Snterm of internal_entry + | Snterml of internal_entry * string | Slist0 of symbol + | Slist0sep of symbol * symbol | Slist1 of symbol + | Slist1sep of symbol * symbol | Sopt of symbol | Sself + | Snext | Stoken of token_pattern | Skeyword of string + | Stree of tree + and tree = + | Node of node | LocAct of Action.t * Action.t list + | DeadEnd + and node = + { node : symbol; son : tree; brother : tree + } + type production_rule = ((symbol list) * Action.t) + type single_extend_statment = + ((string option) * (assoc option) * (production_rule list)) + type extend_statment = + ((position option) * (single_extend_statment list)) + type delete_statment = symbol list + type ('a, 'b, 'c) fold = + internal_entry -> + symbol list -> ('a Stream.t -> 'b) -> 'a Stream.t -> 'c + type ('a, 'b, 'c) foldsep = + internal_entry -> + symbol list -> + ('a Stream.t -> 'b) -> + ('a Stream.t -> unit) -> 'a Stream.t -> 'c + let get_filter g = g.gfilter + type 'a not_filtered = 'a + let using { gkeywords = table; gfilter = filter } kwd = + let r = + try Hashtbl.find table kwd + with + | Not_found -> + let r = ref 0 in (Hashtbl.add table kwd r; r) + in (Token.Filter.keyword_added filter kwd (!r = 0); incr r) + let removing { gkeywords = table; gfilter = filter } kwd = + let r = Hashtbl.find table kwd in + let () = decr r + in + if !r = 0 + then + (Token.Filter.keyword_removed filter kwd; + Hashtbl.remove table kwd) + else () + end + end + module Search = + struct + module Make (Structure : Structure.S) = + struct + open Structure + let tree_in_entry prev_symb tree = + function + | Dlevels levels -> + let rec search_levels = + (function + | [] -> tree + | level :: levels -> + (match search_level level with + | Some tree -> tree + | None -> search_levels levels)) + and search_level level = + (match search_tree level.lsuffix with + | Some t -> + Some + (Node + { + + node = Sself; + son = t; + brother = DeadEnd; + }) + | None -> search_tree level.lprefix) + and search_tree t = + if (tree <> DeadEnd) && (t == tree) + then Some t + else + (match t with + | Node n -> + (match search_symbol n.node with + | Some symb -> + Some + (Node + { + + node = symb; + son = n.son; + brother = DeadEnd; + }) + | None -> + (match search_tree n.son with + | Some t -> + Some + (Node + { + + node = n.node; + son = t; + brother = DeadEnd; + }) + | None -> search_tree n.brother)) + | LocAct (_, _) | DeadEnd -> None) + and search_symbol symb = + (match symb with + | Snterm _ | Snterml (_, _) | Slist0 _ | + Slist0sep (_, _) | Slist1 _ | Slist1sep (_, _) | + Sopt _ | Stoken _ | Stree _ | Skeyword _ when + symb == prev_symb -> Some symb + | Slist0 symb -> + (match search_symbol symb with + | Some symb -> Some (Slist0 symb) + | None -> None) + | Slist0sep (symb, sep) -> + (match search_symbol symb with + | Some symb -> Some (Slist0sep (symb, sep)) + | None -> + (match search_symbol sep with + | Some sep -> Some (Slist0sep (symb, sep)) + | None -> None)) + | Slist1 symb -> + (match search_symbol symb with + | Some symb -> Some (Slist1 symb) + | None -> None) + | Slist1sep (symb, sep) -> + (match search_symbol symb with + | Some symb -> Some (Slist1sep (symb, sep)) + | None -> + (match search_symbol sep with + | Some sep -> Some (Slist1sep (symb, sep)) + | None -> None)) + | Sopt symb -> + (match search_symbol symb with + | Some symb -> Some (Sopt symb) + | None -> None) + | Stree t -> + (match search_tree t with + | Some t -> Some (Stree t) + | None -> None) + | _ -> None) + in search_levels levels + | Dparser _ -> tree + end + end + module Tools = + struct + module Make (Structure : Structure.S) = + struct + open Structure + let empty_entry ename _ _ _ = + raise (Stream.Error ("entry [" ^ (ename ^ "] is empty"))) + let is_level_labelled n lev = + match lev.lname with | Some n1 -> n = n1 | None -> false + let warning_verbose = ref true + let rec get_token_list entry tokl last_tok tree = + match tree with + | Node + { + node = (Stoken _ | Skeyword _ as tok); + son = son; + brother = DeadEnd + } -> get_token_list entry (last_tok :: tokl) tok son + | _ -> + if tokl = [] + then None + else + Some + (((List.rev (last_tok :: tokl)), last_tok, tree)) + let is_antiquot s = + let len = String.length s in (len > 1) && (s.[0] = '$') + let eq_Stoken_ids s1 s2 = + (not (is_antiquot s1)) && + ((not (is_antiquot s2)) && (s1 = s2)) + let logically_eq_symbols entry = + let rec eq_symbols s1 s2 = + match (s1, s2) with + | (Snterm e1, Snterm e2) -> e1.ename = e2.ename + | (Snterm e1, Sself) -> e1.ename = entry.ename + | (Sself, Snterm e2) -> entry.ename = e2.ename + | (Snterml (e1, l1), Snterml (e2, l2)) -> + (e1.ename = e2.ename) && (l1 = l2) + | (Slist0 s1, Slist0 s2) -> eq_symbols s1 s2 + | (Slist0sep (s1, sep1), Slist0sep (s2, sep2)) -> + (eq_symbols s1 s2) && (eq_symbols sep1 sep2) + | (Slist1 s1, Slist1 s2) -> eq_symbols s1 s2 + | (Slist1sep (s1, sep1), Slist1sep (s2, sep2)) -> + (eq_symbols s1 s2) && (eq_symbols sep1 sep2) + | (Sopt s1, Sopt s2) -> eq_symbols s1 s2 + | (Stree t1, Stree t2) -> eq_trees t1 t2 + | (Stoken ((_, s1)), Stoken ((_, s2))) -> + eq_Stoken_ids s1 s2 + | _ -> s1 = s2 + and eq_trees t1 t2 = + match (t1, t2) with + | (Node n1, Node n2) -> + (eq_symbols n1.node n2.node) && + ((eq_trees n1.son n2.son) && + (eq_trees n1.brother n2.brother)) + | ((LocAct (_, _) | DeadEnd), (LocAct (_, _) | DeadEnd)) + -> true + | _ -> false + in eq_symbols + let rec eq_symbol s1 s2 = + match (s1, s2) with + | (Snterm e1, Snterm e2) -> e1 == e2 + | (Snterml (e1, l1), Snterml (e2, l2)) -> + (e1 == e2) && (l1 = l2) + | (Slist0 s1, Slist0 s2) -> eq_symbol s1 s2 + | (Slist0sep (s1, sep1), Slist0sep (s2, sep2)) -> + (eq_symbol s1 s2) && (eq_symbol sep1 sep2) + | (Slist1 s1, Slist1 s2) -> eq_symbol s1 s2 + | (Slist1sep (s1, sep1), Slist1sep (s2, sep2)) -> + (eq_symbol s1 s2) && (eq_symbol sep1 sep2) + | (Sopt s1, Sopt s2) -> eq_symbol s1 s2 + | (Stree _, Stree _) -> false + | (Stoken ((_, s1)), Stoken ((_, s2))) -> + eq_Stoken_ids s1 s2 + | _ -> s1 = s2 + end + end + module Print : + sig + module Make (Structure : Structure.S) : + sig + val flatten_tree : + Structure.tree -> (Structure.symbol list) list + val print_symbol : + Format.formatter -> Structure.symbol -> unit + val print_meta : + Format.formatter -> string -> Structure.symbol list -> unit + val print_symbol1 : + Format.formatter -> Structure.symbol -> unit + val print_rule : + Format.formatter -> Structure.symbol list -> unit + val print_level : + Format.formatter -> + (Format.formatter -> unit -> unit) -> + (Structure.symbol list) list -> unit + val levels : Format.formatter -> Structure.level list -> unit + val entry : + Format.formatter -> Structure.internal_entry -> unit + end + module MakeDump (Structure : Structure.S) : + sig + val print_symbol : + Format.formatter -> Structure.symbol -> unit + val print_meta : + Format.formatter -> string -> Structure.symbol list -> unit + val print_symbol1 : + Format.formatter -> Structure.symbol -> unit + val print_rule : + Format.formatter -> Structure.symbol list -> unit + val print_level : + Format.formatter -> + (Format.formatter -> unit -> unit) -> + (Structure.symbol list) list -> unit + val levels : Format.formatter -> Structure.level list -> unit + val entry : + Format.formatter -> Structure.internal_entry -> unit + end + end = + struct + module Make (Structure : Structure.S) = + struct + open Structure + open Format + open Sig.Grammar + let rec flatten_tree = + function + | DeadEnd -> [] + | LocAct (_, _) -> [ [] ] + | Node { node = n; brother = b; son = s } -> + (List.map (fun l -> n :: l) (flatten_tree s)) @ + (flatten_tree b) + let rec print_symbol ppf = + function + | Smeta (n, sl, _) -> print_meta ppf n sl + | Slist0 s -> fprintf ppf "LIST0 %a" print_symbol1 s + | Slist0sep (s, t) -> + fprintf ppf "LIST0 %a SEP %a" print_symbol1 s + print_symbol1 t + | Slist1 s -> fprintf ppf "LIST1 %a" print_symbol1 s + | Slist1sep (s, t) -> + fprintf ppf "LIST1 %a SEP %a" print_symbol1 s + print_symbol1 t + | Sopt s -> fprintf ppf "OPT %a" print_symbol1 s + | Snterml (e, l) -> fprintf ppf "%s@ LEVEL@ %S" e.ename l + | (Snterm _ | Snext | Sself | Stree _ | Stoken _ | + Skeyword _ + as s) -> print_symbol1 ppf s + and print_meta ppf n sl = + let rec loop i = + function + | [] -> () + | s :: sl -> + let j = + (try String.index_from n i ' ' + with | Not_found -> String.length n) + in + (fprintf ppf "%s %a" (String.sub n i (j - i)) + print_symbol1 s; + if sl = [] + then () + else + (fprintf ppf " "; + loop (min (j + 1) (String.length n)) sl)) + in loop 0 sl + and print_symbol1 ppf = + function + | Snterm e -> pp_print_string ppf e.ename + | Sself -> pp_print_string ppf "SELF" + | Snext -> pp_print_string ppf "NEXT" + | Stoken ((_, descr)) -> pp_print_string ppf descr + | Skeyword s -> fprintf ppf "%S" s + | Stree t -> + print_level ppf pp_print_space (flatten_tree t) + | (Smeta (_, _, _) | Snterml (_, _) | Slist0 _ | + Slist0sep (_, _) | Slist1 _ | Slist1sep (_, _) | + Sopt _ + as s) -> fprintf ppf "(%a)" print_symbol s + and print_rule ppf symbols = + (fprintf ppf "@[<hov 0>"; + let _ = + List.fold_left + (fun sep symbol -> + (fprintf ppf "%t%a" sep print_symbol symbol; + fun ppf -> fprintf ppf ";@ ")) + (fun _ -> ()) symbols + in fprintf ppf "@]") + and print_level ppf pp_print_space rules = + (fprintf ppf "@[<hov 0>[ "; + let _ = + List.fold_left + (fun sep rule -> + (fprintf ppf "%t%a" sep print_rule rule; + fun ppf -> fprintf ppf "%a| " pp_print_space ())) + (fun _ -> ()) rules + in fprintf ppf " ]@]") + let levels ppf elev = + let _ = + List.fold_left + (fun sep lev -> + let rules = + (List.map (fun t -> Sself :: t) + (flatten_tree lev.lsuffix)) + @ (flatten_tree lev.lprefix) + in + (fprintf ppf "%t@[<hov 2>" sep; + (match lev.lname with + | Some n -> fprintf ppf "%S@;<1 2>" n + | None -> ()); + (match lev.assoc with + | LeftA -> fprintf ppf "LEFTA" + | RightA -> fprintf ppf "RIGHTA" + | NonA -> fprintf ppf "NONA"); + fprintf ppf "@]@;<1 2>"; + print_level ppf pp_force_newline rules; + fun ppf -> fprintf ppf "@,| ")) + (fun _ -> ()) elev + in () + let entry ppf e = + (fprintf ppf "@[<v 0>%s: [ " e.ename; + (match e.edesc with + | Dlevels elev -> levels ppf elev + | Dparser _ -> fprintf ppf "<parser>"); + fprintf ppf " ]@]") + end + module MakeDump (Structure : Structure.S) = + struct + open Structure + open Format + open Sig.Grammar + type brothers = | Bro of symbol * brothers list + let rec print_tree ppf tree = + let rec get_brothers acc = + function + | DeadEnd -> List.rev acc + | LocAct (_, _) -> List.rev acc + | Node { node = n; brother = b; son = s } -> + get_brothers ((Bro (n, get_brothers [] s)) :: acc) b + and print_brothers ppf brothers = + if brothers = [] + then fprintf ppf "@ []" + else + List.iter + (function + | Bro (n, xs) -> + (fprintf ppf "@ @[<hv2>- %a" print_symbol n; + (match xs with + | [] -> () + | [ _ ] -> + (try + print_children ppf (get_children [] xs) + with + | Exit -> + fprintf ppf ":%a" print_brothers xs) + | _ -> fprintf ppf ":%a" print_brothers xs); + fprintf ppf "@]")) + brothers + and print_children ppf = + List.iter (fprintf ppf ";@ %a" print_symbol) + and get_children acc = + function + | [] -> List.rev acc + | [ Bro (n, x) ] -> get_children (n :: acc) x + | _ -> raise Exit + in print_brothers ppf (get_brothers [] tree) + and print_symbol ppf = + function + | Smeta (n, sl, _) -> print_meta ppf n sl + | Slist0 s -> fprintf ppf "LIST0 %a" print_symbol1 s + | Slist0sep (s, t) -> + fprintf ppf "LIST0 %a SEP %a" print_symbol1 s + print_symbol1 t + | Slist1 s -> fprintf ppf "LIST1 %a" print_symbol1 s + | Slist1sep (s, t) -> + fprintf ppf "LIST1 %a SEP %a" print_symbol1 s + print_symbol1 t + | Sopt s -> fprintf ppf "OPT %a" print_symbol1 s + | Snterml (e, l) -> fprintf ppf "%s@ LEVEL@ %S" e.ename l + | (Snterm _ | Snext | Sself | Stree _ | Stoken _ | + Skeyword _ + as s) -> print_symbol1 ppf s + and print_meta ppf n sl = + let rec loop i = + function + | [] -> () + | s :: sl -> + let j = + (try String.index_from n i ' ' + with | Not_found -> String.length n) + in + (fprintf ppf "%s %a" (String.sub n i (j - i)) + print_symbol1 s; + if sl = [] + then () + else + (fprintf ppf " "; + loop (min (j + 1) (String.length n)) sl)) + in loop 0 sl + and print_symbol1 ppf = + function + | Snterm e -> pp_print_string ppf e.ename + | Sself -> pp_print_string ppf "SELF" + | Snext -> pp_print_string ppf "NEXT" + | Stoken ((_, descr)) -> pp_print_string ppf descr + | Skeyword s -> fprintf ppf "%S" s + | Stree t -> print_tree ppf t + | (Smeta (_, _, _) | Snterml (_, _) | Slist0 _ | + Slist0sep (_, _) | Slist1 _ | Slist1sep (_, _) | + Sopt _ + as s) -> fprintf ppf "(%a)" print_symbol s + and print_rule ppf symbols = + (fprintf ppf "@[<hov 0>"; + let _ = + List.fold_left + (fun sep symbol -> + (fprintf ppf "%t%a" sep print_symbol symbol; + fun ppf -> fprintf ppf ";@ ")) + (fun _ -> ()) symbols + in fprintf ppf "@]") + and print_level ppf pp_print_space rules = + (fprintf ppf "@[<hov 0>[ "; + let _ = + List.fold_left + (fun sep rule -> + (fprintf ppf "%t%a" sep print_rule rule; + fun ppf -> fprintf ppf "%a| " pp_print_space ())) + (fun _ -> ()) rules + in fprintf ppf " ]@]") + let levels ppf elev = + let _ = + List.fold_left + (fun sep lev -> + (fprintf ppf "%t@[<v2>" sep; + (match lev.lname with + | Some n -> fprintf ppf "%S@;<1 2>" n + | None -> ()); + (match lev.assoc with + | LeftA -> fprintf ppf "LEFTA" + | RightA -> fprintf ppf "RIGHTA" + | NonA -> fprintf ppf "NONA"); + fprintf ppf "@]@;<1 2>"; + fprintf ppf "@[<v2>suffix:@ "; + print_tree ppf lev.lsuffix; + fprintf ppf "@]@ @[<v2>prefix:@ "; + print_tree ppf lev.lprefix; + fprintf ppf "@]"; + fun ppf -> fprintf ppf "@,| ")) + (fun _ -> ()) elev + in () + let entry ppf e = + (fprintf ppf "@[<v 0>%s: [ " e.ename; + (match e.edesc with + | Dlevels elev -> levels ppf elev + | Dparser _ -> fprintf ppf "<parser>"); + fprintf ppf " ]@]") + end + end + module Failed = + struct + module Make (Structure : Structure.S) = + struct + module Tools = Tools.Make(Structure) + module Search = Search.Make(Structure) + module Print = Print.Make(Structure) + open Structure + open Format + let rec name_of_symbol entry = + function + | Snterm e -> "[" ^ (e.ename ^ "]") + | Snterml (e, l) -> + "[" ^ (e.ename ^ (" level " ^ (l ^ "]"))) + | Sself | Snext -> "[" ^ (entry.ename ^ "]") + | Stoken ((_, descr)) -> descr + | Skeyword kwd -> "\"" ^ (kwd ^ "\"") + | _ -> "???" + let rec name_of_symbol_failed entry = + function + | Slist0 s -> name_of_symbol_failed entry s + | Slist0sep (s, _) -> name_of_symbol_failed entry s + | Slist1 s -> name_of_symbol_failed entry s + | Slist1sep (s, _) -> name_of_symbol_failed entry s + | Sopt s -> name_of_symbol_failed entry s + | Stree t -> name_of_tree_failed entry t + | s -> name_of_symbol entry s + and name_of_tree_failed entry = + function + | Node { node = s; brother = bro; son = son } -> + let tokl = + (match s with + | Stoken _ | Skeyword _ -> + Tools.get_token_list entry [] s son + | _ -> None) + in + (match tokl with + | None -> + let txt = name_of_symbol_failed entry s in + let txt = + (match (s, son) with + | (Sopt _, Node _) -> + txt ^ + (" or " ^ + (name_of_tree_failed entry son)) + | _ -> txt) in + let txt = + (match bro with + | DeadEnd | LocAct (_, _) -> txt + | Node _ -> + txt ^ + (" or " ^ + (name_of_tree_failed entry bro))) + in txt + | Some ((tokl, _, _)) -> + List.fold_left + (fun s tok -> + (if s = "" then "" else s ^ " then ") ^ + (match tok with + | Stoken ((_, descr)) -> descr + | Skeyword kwd -> kwd + | _ -> assert false)) + "" tokl) + | DeadEnd | LocAct (_, _) -> "???" + let magic _s x = Obj.magic x + let tree_failed entry prev_symb_result prev_symb tree = + let txt = name_of_tree_failed entry tree in + let txt = + match prev_symb with + | Slist0 s -> + let txt1 = name_of_symbol_failed entry s + in txt1 ^ (" or " ^ (txt ^ " expected")) + | Slist1 s -> + let txt1 = name_of_symbol_failed entry s + in txt1 ^ (" or " ^ (txt ^ " expected")) + | Slist0sep (s, sep) -> + (match magic "tree_failed: 'a -> list 'b" + prev_symb_result + with + | [] -> + let txt1 = name_of_symbol_failed entry s + in txt1 ^ (" or " ^ (txt ^ " expected")) + | _ -> + let txt1 = name_of_symbol_failed entry sep + in txt1 ^ (" or " ^ (txt ^ " expected"))) + | Slist1sep (s, sep) -> + (match magic "tree_failed: 'a -> list 'b" + prev_symb_result + with + | [] -> + let txt1 = name_of_symbol_failed entry s + in txt1 ^ (" or " ^ (txt ^ " expected")) + | _ -> + let txt1 = name_of_symbol_failed entry sep + in txt1 ^ (" or " ^ (txt ^ " expected"))) + | Sopt _ | Stree _ -> txt ^ " expected" + | _ -> + txt ^ + (" expected after " ^ + (name_of_symbol entry prev_symb)) + in + (if !(entry.egram.error_verbose) + then + (let tree = + Search.tree_in_entry prev_symb tree entry.edesc in + let ppf = err_formatter + in + (fprintf ppf "@[<v 0>@,"; + fprintf ppf "----------------------------------@,"; + fprintf ppf + "Parse error in entry [%s], rule:@;<0 2>" + entry.ename; + fprintf ppf "@["; + Print.print_level ppf pp_force_newline + (Print.flatten_tree tree); + fprintf ppf "@]@,"; + fprintf ppf "----------------------------------@,"; + fprintf ppf "@]@.")) + else (); + txt ^ (" (in [" ^ (entry.ename ^ "])"))) + let symb_failed entry prev_symb_result prev_symb symb = + let tree = + Node { node = symb; brother = DeadEnd; son = DeadEnd; } + in tree_failed entry prev_symb_result prev_symb tree + let symb_failed_txt e s1 s2 = symb_failed e 0 s1 s2 + end + end + module Parser = + struct + module Make (Structure : Structure.S) = + struct + module Tools = Tools.Make(Structure) + module Failed = Failed.Make(Structure) + module Print = Print.Make(Structure) + open Structure + open Sig.Grammar + module Stream = + struct + include Stream + let junk strm = Context.junk strm + let count strm = Context.bp strm + end + let add_loc c bp parse_fun strm = + let x = parse_fun c strm in + let ep = Context.loc_ep c in + let loc = Loc.merge bp ep in (x, loc) + let level_number entry lab = + let rec lookup levn = + function + | [] -> failwith ("unknown level " ^ lab) + | lev :: levs -> + if Tools.is_level_labelled lab lev + then levn + else lookup (succ levn) levs + in + match entry.edesc with + | Dlevels elev -> lookup 0 elev + | Dparser _ -> raise Not_found + let strict_parsing = ref false + let strict_parsing_warning = ref false + let rec top_symb entry = + function + | Sself | Snext -> Snterm entry + | Snterml (e, _) -> Snterm e + | Slist1sep (s, sep) -> Slist1sep (top_symb entry s, sep) + | _ -> raise Stream.Failure + let top_tree entry = + function + | Node { node = s; brother = bro; son = son } -> + Node + { node = top_symb entry s; brother = bro; son = son; + } + | LocAct (_, _) | DeadEnd -> raise Stream.Failure + let entry_of_symb entry = + function + | Sself | Snext -> entry + | Snterm e -> e + | Snterml (e, _) -> e + | _ -> raise Stream.Failure + let continue entry loc a s c son p1 (__strm : _ Stream.t) = + let a = + (entry_of_symb entry s).econtinue 0 loc a c __strm in + let act = + try p1 __strm + with + | Stream.Failure -> + raise + (Stream.Error (Failed.tree_failed entry a s son)) + in Action.mk (fun _ -> Action.getf act a) + let skip_if_empty c bp p strm = + if (Context.loc_ep c) == bp + then Action.mk (fun _ -> p strm) + else raise Stream.Failure + let do_recover parser_of_tree entry nlevn alevn loc a s c son + (__strm : _ Stream.t) = + try + parser_of_tree entry nlevn alevn (top_tree entry son) c + __strm + with + | Stream.Failure -> + (try + skip_if_empty c loc + (fun (__strm : _ Stream.t) -> raise Stream.Failure) + __strm + with + | Stream.Failure -> + continue entry loc a s c son + (parser_of_tree entry nlevn alevn son c) __strm) + let recover parser_of_tree entry nlevn alevn loc a s c son + strm = + if !strict_parsing + then + raise (Stream.Error (Failed.tree_failed entry a s son)) + else + (let _ = + if !strict_parsing_warning + then + (let msg = Failed.tree_failed entry a s son + in + (Format.eprintf + "Warning: trying to recover from syntax error"; + if entry.ename <> "" + then Format.eprintf " in [%s]" entry.ename + else (); + Format.eprintf "\n%s%a@." msg Loc.print loc)) + else () + in + do_recover parser_of_tree entry nlevn alevn loc a s c + son strm) + let rec parser_of_tree entry nlevn alevn = + function + | DeadEnd -> + (fun _ (__strm : _ Stream.t) -> raise Stream.Failure) + | LocAct (act, _) -> (fun _ (__strm : _ Stream.t) -> act) + | Node + { + node = Sself; + son = LocAct (act, _); + brother = DeadEnd + } -> + (fun c (__strm : _ Stream.t) -> + let a = entry.estart alevn c __strm + in Action.getf act a) + | Node { node = Sself; son = LocAct (act, _); brother = bro + } -> + let p2 = parser_of_tree entry nlevn alevn bro + in + (fun c (__strm : _ Stream.t) -> + match try Some (entry.estart alevn c __strm) + with | Stream.Failure -> None + with + | Some a -> Action.getf act a + | _ -> p2 c __strm) + | Node { node = s; son = son; brother = DeadEnd } -> + let tokl = + (match s with + | Stoken _ | Skeyword _ -> + Tools.get_token_list entry [] s son + | _ -> None) + in + (match tokl with + | None -> + let ps = parser_of_symbol entry nlevn s in + let p1 = parser_of_tree entry nlevn alevn son in + let p1 = parser_cont p1 entry nlevn alevn s son + in + (fun c (__strm : _ Stream.t) -> + let bp = Stream.count __strm in + let a = ps c __strm in + let act = + try p1 c bp a __strm + with + | Stream.Failure -> + raise (Stream.Error "") + in Action.getf act a) + | Some ((tokl, last_tok, son)) -> + let p1 = parser_of_tree entry nlevn alevn son in + let p1 = + parser_cont p1 entry nlevn alevn last_tok son + in parser_of_token_list p1 tokl) + | Node { node = s; son = son; brother = bro } -> + let tokl = + (match s with + | Stoken _ | Skeyword _ -> + Tools.get_token_list entry [] s son + | _ -> None) + in + (match tokl with + | None -> + let ps = parser_of_symbol entry nlevn s in + let p1 = parser_of_tree entry nlevn alevn son in + let p1 = + parser_cont p1 entry nlevn alevn s son in + let p2 = parser_of_tree entry nlevn alevn bro + in + (fun c (__strm : _ Stream.t) -> + let bp = Stream.count __strm + in + match try Some (ps c __strm) + with | Stream.Failure -> None + with + | Some a -> + let act = + (try p1 c bp a __strm + with + | Stream.Failure -> + raise (Stream.Error "")) + in Action.getf act a + | _ -> p2 c __strm) + | Some ((tokl, last_tok, son)) -> + let p1 = parser_of_tree entry nlevn alevn son in + let p1 = + parser_cont p1 entry nlevn alevn last_tok son in + let p1 = parser_of_token_list p1 tokl in + let p2 = parser_of_tree entry nlevn alevn bro + in + (fun c (__strm : _ Stream.t) -> + try p1 c __strm + with | Stream.Failure -> p2 c __strm)) + and + parser_cont p1 entry nlevn alevn s son c loc a + (__strm : _ Stream.t) = + try p1 c __strm + with + | Stream.Failure -> + (try + recover parser_of_tree entry nlevn alevn loc a s c + son __strm + with + | Stream.Failure -> + raise + (Stream.Error (Failed.tree_failed entry a s son))) + and parser_of_token_list p1 tokl = + let rec loop n = + function + | Stoken ((tematch, _)) :: tokl -> + (match tokl with + | [] -> + let ps c _ = + (match Context.peek_nth c n with + | Some ((tok, _)) when tematch tok -> + (Context.njunk c n; Action.mk tok) + | _ -> raise Stream.Failure) + in + (fun c (__strm : _ Stream.t) -> + let bp = Stream.count __strm in + let a = ps c __strm in + let act = + try p1 c bp a __strm + with + | Stream.Failure -> + raise (Stream.Error "") + in Action.getf act a) + | _ -> + let ps c _ = + (match Context.peek_nth c n with + | Some ((tok, _)) when tematch tok -> tok + | _ -> raise Stream.Failure) in + let p1 = loop (n + 1) tokl + in + (fun c (__strm : _ Stream.t) -> + let tok = ps c __strm in + let s = __strm in + let act = p1 c s in Action.getf act tok)) + | Skeyword kwd :: tokl -> + (match tokl with + | [] -> + let ps c _ = + (match Context.peek_nth c n with + | Some ((tok, _)) when + Token.match_keyword kwd tok -> + (Context.njunk c n; Action.mk tok) + | _ -> raise Stream.Failure) + in + (fun c (__strm : _ Stream.t) -> + let bp = Stream.count __strm in + let a = ps c __strm in + let act = + try p1 c bp a __strm + with + | Stream.Failure -> + raise (Stream.Error "") + in Action.getf act a) + | _ -> + let ps c _ = + (match Context.peek_nth c n with + | Some ((tok, _)) when + Token.match_keyword kwd tok -> tok + | _ -> raise Stream.Failure) in + let p1 = loop (n + 1) tokl + in + (fun c (__strm : _ Stream.t) -> + let tok = ps c __strm in + let s = __strm in + let act = p1 c s in Action.getf act tok)) + | _ -> invalid_arg "parser_of_token_list" + in loop 1 tokl + and parser_of_symbol entry nlevn = + function + | Smeta (_, symbl, act) -> + let act = Obj.magic act entry symbl in + let pl = List.map (parser_of_symbol entry nlevn) symbl + in + (fun c -> + Obj.magic + (List.fold_left + (fun act p -> Obj.magic act (p c)) act pl)) + | Slist0 s -> + let ps = parser_of_symbol entry nlevn s in + let rec loop c al (__strm : _ Stream.t) = + (match try Some (ps c __strm) + with | Stream.Failure -> None + with + | Some a -> loop c (a :: al) __strm + | _ -> al) + in + (fun c (__strm : _ Stream.t) -> + let a = loop c [] __strm in Action.mk (List.rev a)) + | Slist0sep (symb, sep) -> + let ps = parser_of_symbol entry nlevn symb in + let pt = parser_of_symbol entry nlevn sep in + let rec kont c al (__strm : _ Stream.t) = + (match try Some (pt c __strm) + with | Stream.Failure -> None + with + | Some v -> + let a = + (try ps c __strm + with + | Stream.Failure -> + raise + (Stream.Error + (Failed.symb_failed entry v sep symb))) + in kont c (a :: al) __strm + | _ -> al) + in + (fun c (__strm : _ Stream.t) -> + match try Some (ps c __strm) + with | Stream.Failure -> None + with + | Some a -> + let s = __strm + in Action.mk (List.rev (kont c [ a ] s)) + | _ -> Action.mk []) + | Slist1 s -> + let ps = parser_of_symbol entry nlevn s in + let rec loop c al (__strm : _ Stream.t) = + (match try Some (ps c __strm) + with | Stream.Failure -> None + with + | Some a -> loop c (a :: al) __strm + | _ -> al) + in + (fun c (__strm : _ Stream.t) -> + let a = ps c __strm in + let s = __strm + in Action.mk (List.rev (loop c [ a ] s))) + | Slist1sep (symb, sep) -> + let ps = parser_of_symbol entry nlevn symb in + let pt = parser_of_symbol entry nlevn sep in + let rec kont c al (__strm : _ Stream.t) = + (match try Some (pt c __strm) + with | Stream.Failure -> None + with + | Some v -> + let a = + (try ps c __strm + with + | Stream.Failure -> + (try parse_top_symb' entry symb c __strm + with + | Stream.Failure -> + raise + (Stream.Error + (Failed.symb_failed entry v sep + symb)))) + in kont c (a :: al) __strm + | _ -> al) + in + (fun c (__strm : _ Stream.t) -> + let a = ps c __strm in + let s = __strm + in Action.mk (List.rev (kont c [ a ] s))) + | Sopt s -> + let ps = parser_of_symbol entry nlevn s + in + (fun c (__strm : _ Stream.t) -> + match try Some (ps c __strm) + with | Stream.Failure -> None + with + | Some a -> Action.mk (Some a) + | _ -> Action.mk None) + | Stree t -> + let pt = parser_of_tree entry 1 0 t + in + (fun c (__strm : _ Stream.t) -> + let bp = Stream.count __strm in + let (act, loc) = add_loc c bp pt __strm + in Action.getf act loc) + | Snterm e -> + (fun c (__strm : _ Stream.t) -> e.estart 0 c __strm) + | Snterml (e, l) -> + (fun c (__strm : _ Stream.t) -> + e.estart (level_number e l) c __strm) + | Sself -> + (fun c (__strm : _ Stream.t) -> entry.estart 0 c __strm) + | Snext -> + (fun c (__strm : _ Stream.t) -> + entry.estart nlevn c __strm) + | Skeyword kwd -> + (fun _ (__strm : _ Stream.t) -> + match Stream.peek __strm with + | Some ((tok, _)) when Token.match_keyword kwd tok + -> (Stream.junk __strm; Action.mk tok) + | _ -> raise Stream.Failure) + | Stoken ((f, _)) -> + (fun _ (__strm : _ Stream.t) -> + match Stream.peek __strm with + | Some ((tok, _)) when f tok -> + (Stream.junk __strm; Action.mk tok) + | _ -> raise Stream.Failure) + and parse_top_symb' entry symb c = + parser_of_symbol entry 0 (top_symb entry symb) c + and parse_top_symb entry symb strm = + Context.call_with_ctx strm + (fun c -> parse_top_symb' entry symb c (Context.stream c)) + let rec start_parser_of_levels entry clevn = + function + | [] -> + (fun _ _ (__strm : _ Stream.t) -> raise Stream.Failure) + | lev :: levs -> + let p1 = start_parser_of_levels entry (succ clevn) levs + in + (match lev.lprefix with + | DeadEnd -> p1 + | tree -> + let alevn = + (match lev.assoc with + | LeftA | NonA -> succ clevn + | RightA -> clevn) in + let p2 = + parser_of_tree entry (succ clevn) alevn tree + in + (match levs with + | [] -> + (fun levn c (__strm : _ Stream.t) -> + let bp = Stream.count __strm in + let (act, loc) = + add_loc c bp p2 __strm in + let strm = __strm in + let a = Action.getf act loc + in entry.econtinue levn loc a c strm) + | _ -> + (fun levn c strm -> + if levn > clevn + then p1 levn c strm + else + (let (__strm : _ Stream.t) = strm in + let bp = Stream.count __strm + in + match try + Some + (add_loc c bp p2 __strm) + with + | Stream.Failure -> None + with + | Some ((act, loc)) -> + let a = Action.getf act loc + in + entry.econtinue levn loc a + c strm + | _ -> p1 levn c __strm)))) + let start_parser_of_entry entry = + match entry.edesc with + | Dlevels [] -> Tools.empty_entry entry.ename + | Dlevels elev -> start_parser_of_levels entry 0 elev + | Dparser p -> (fun _ _ strm -> p strm) + let rec continue_parser_of_levels entry clevn = + function + | [] -> + (fun _ _ _ _ (__strm : _ Stream.t) -> + raise Stream.Failure) + | lev :: levs -> + let p1 = + continue_parser_of_levels entry (succ clevn) levs + in + (match lev.lsuffix with + | DeadEnd -> p1 + | tree -> + let alevn = + (match lev.assoc with + | LeftA | NonA -> succ clevn + | RightA -> clevn) in + let p2 = + parser_of_tree entry (succ clevn) alevn tree + in + (fun c levn bp a strm -> + if levn > clevn + then p1 c levn bp a strm + else + (let (__strm : _ Stream.t) = strm in + let bp = Stream.count __strm + in + try p1 c levn bp a __strm + with + | Stream.Failure -> + let (act, loc) = + add_loc c bp p2 __strm in + let a = Action.getf2 act a loc + in + entry.econtinue levn loc a c + strm))) + let continue_parser_of_entry entry = + match entry.edesc with + | Dlevels elev -> + let p = continue_parser_of_levels entry 0 elev + in + (fun levn bp a c (__strm : _ Stream.t) -> + try p c levn bp a __strm + with | Stream.Failure -> a) + | Dparser _ -> + (fun _ _ _ _ (__strm : _ Stream.t) -> + raise Stream.Failure) + end + end + module Insert = + struct + module Make (Structure : Structure.S) = + struct + module Tools = Tools.Make(Structure) + module Parser = Parser.Make(Structure) + open Structure + open Format + open Sig.Grammar + let is_before s1 s2 = + match (s1, s2) with + | ((Skeyword _ | Stoken _), (Skeyword _ | Stoken _)) -> + false + | ((Skeyword _ | Stoken _), _) -> true + | _ -> false + let rec derive_eps = + function + | Slist0 _ -> true + | Slist0sep (_, _) -> true + | Sopt _ -> true + | Stree t -> tree_derive_eps t + | Smeta (_, _, _) | Slist1 _ | Slist1sep (_, _) | Snterm _ + | Snterml (_, _) | Snext | Sself | Stoken _ | + Skeyword _ -> false + and tree_derive_eps = + function + | LocAct (_, _) -> true + | Node { node = s; brother = bro; son = son } -> + ((derive_eps s) && (tree_derive_eps son)) || + (tree_derive_eps bro) + | DeadEnd -> false + let empty_lev lname assoc = + let assoc = match assoc with | Some a -> a | None -> LeftA + in + { + + assoc = assoc; + lname = lname; + lsuffix = DeadEnd; + lprefix = DeadEnd; + } + let change_lev entry lev n lname assoc = + let a = + match assoc with + | None -> lev.assoc + | Some a -> + (if + (a <> lev.assoc) && !(entry.egram.warning_verbose) + then + (eprintf + "<W> Changing associativity of level \"%s\"\n" + n; + flush stderr) + else (); + a) + in + ((match lname with + | Some n -> + if + (lname <> lev.lname) && + !(entry.egram.warning_verbose) + then + (eprintf "<W> Level label \"%s\" ignored\n" n; + flush stderr) + else () + | None -> ()); + { + + assoc = a; + lname = lev.lname; + lsuffix = lev.lsuffix; + lprefix = lev.lprefix; + }) + let change_to_self entry = + function | Snterm e when e == entry -> Sself | x -> x + let get_level entry position levs = + match position with + | Some First -> ([], empty_lev, levs) + | Some Last -> (levs, empty_lev, []) + | Some (Level n) -> + let rec get = + (function + | [] -> + (eprintf + "No level labelled \"%s\" in entry \"%s\"\n" + n entry.ename; + flush stderr; + failwith "Grammar.extend") + | lev :: levs -> + if Tools.is_level_labelled n lev + then ([], (change_lev entry lev n), levs) + else + (let (levs1, rlev, levs2) = get levs + in ((lev :: levs1), rlev, levs2))) + in get levs + | Some (Before n) -> + let rec get = + (function + | [] -> + (eprintf + "No level labelled \"%s\" in entry \"%s\"\n" + n entry.ename; + flush stderr; + failwith "Grammar.extend") + | lev :: levs -> + if Tools.is_level_labelled n lev + then ([], empty_lev, (lev :: levs)) + else + (let (levs1, rlev, levs2) = get levs + in ((lev :: levs1), rlev, levs2))) + in get levs + | Some (After n) -> + let rec get = + (function + | [] -> + (eprintf + "No level labelled \"%s\" in entry \"%s\"\n" + n entry.ename; + flush stderr; + failwith "Grammar.extend") + | lev :: levs -> + if Tools.is_level_labelled n lev + then ([ lev ], empty_lev, levs) + else + (let (levs1, rlev, levs2) = get levs + in ((lev :: levs1), rlev, levs2))) + in get levs + | None -> + (match levs with + | lev :: levs -> + ([], (change_lev entry lev "<top>"), levs) + | [] -> ([], empty_lev, [])) + let rec check_gram entry = + function + | Snterm e -> + if e.egram != entry.egram + then + (eprintf + "\ + Error: entries \"%s\" and \"%s\" do not belong to the same grammar.\n" + entry.ename e.ename; + flush stderr; + failwith "Grammar.extend error") + else () + | Snterml (e, _) -> + if e.egram != entry.egram + then + (eprintf + "\ + Error: entries \"%s\" and \"%s\" do not belong to the same grammar.\n" + entry.ename e.ename; + flush stderr; + failwith "Grammar.extend error") + else () + | Smeta (_, sl, _) -> List.iter (check_gram entry) sl + | Slist0sep (s, t) -> + (check_gram entry t; check_gram entry s) + | Slist1sep (s, t) -> + (check_gram entry t; check_gram entry s) + | Slist0 s -> check_gram entry s + | Slist1 s -> check_gram entry s + | Sopt s -> check_gram entry s + | Stree t -> tree_check_gram entry t + | Snext | Sself | Stoken _ | Skeyword _ -> () + and tree_check_gram entry = + function + | Node { node = n; brother = bro; son = son } -> + (check_gram entry n; + tree_check_gram entry bro; + tree_check_gram entry son) + | LocAct (_, _) | DeadEnd -> () + let get_initial = + function + | Sself :: symbols -> (true, symbols) + | symbols -> (false, symbols) + let insert_tokens gram symbols = + let rec insert = + function + | Smeta (_, sl, _) -> List.iter insert sl + | Slist0 s -> insert s + | Slist1 s -> insert s + | Slist0sep (s, t) -> (insert s; insert t) + | Slist1sep (s, t) -> (insert s; insert t) + | Sopt s -> insert s + | Stree t -> tinsert t + | Skeyword kwd -> using gram kwd + | Snterm _ | Snterml (_, _) | Snext | Sself | Stoken _ -> + () + and tinsert = + function + | Node { node = s; brother = bro; son = son } -> + (insert s; tinsert bro; tinsert son) + | LocAct (_, _) | DeadEnd -> () + in List.iter insert symbols + let insert_tree entry gsymbols action tree = + let rec insert symbols tree = + match symbols with + | s :: sl -> insert_in_tree s sl tree + | [] -> + (match tree with + | Node { node = s; son = son; brother = bro } -> + Node + { + + node = s; + son = son; + brother = insert [] bro; + } + | LocAct (old_action, action_list) -> + let () = + if !(entry.egram.warning_verbose) + then + eprintf + "<W> Grammar extension: in [%s] some rule has been masked@." + entry.ename + else () + in LocAct (action, old_action :: action_list) + | DeadEnd -> LocAct (action, [])) + and insert_in_tree s sl tree = + match try_insert s sl tree with + | Some t -> t + | None -> + Node + { + + node = s; + son = insert sl DeadEnd; + brother = tree; + } + and try_insert s sl tree = + match tree with + | Node { node = s1; son = son; brother = bro } -> + if Tools.eq_symbol s s1 + then + (let t = + Node + { + + node = s1; + son = insert sl son; + brother = bro; + } + in Some t) + else + if + (is_before s1 s) || + ((derive_eps s) && (not (derive_eps s1))) + then + (let bro = + match try_insert s sl bro with + | Some bro -> bro + | None -> + Node + { + + node = s; + son = insert sl DeadEnd; + brother = bro; + } in + let t = + Node { node = s1; son = son; brother = bro; } + in Some t) + else + (match try_insert s sl bro with + | Some bro -> + let t = + Node + { node = s1; son = son; brother = bro; + } + in Some t + | None -> None) + | LocAct (_, _) | DeadEnd -> None + and insert_new = + function + | s :: sl -> + Node + { + + node = s; + son = insert_new sl; + brother = DeadEnd; + } + | [] -> LocAct (action, []) + in insert gsymbols tree + let insert_level entry e1 symbols action slev = + match e1 with + | true -> + { + + assoc = slev.assoc; + lname = slev.lname; + lsuffix = + insert_tree entry symbols action slev.lsuffix; + lprefix = slev.lprefix; + } + | false -> + { + + assoc = slev.assoc; + lname = slev.lname; + lsuffix = slev.lsuffix; + lprefix = + insert_tree entry symbols action slev.lprefix; + } + let levels_of_rules entry position rules = + let elev = + match entry.edesc with + | Dlevels elev -> elev + | Dparser _ -> + (eprintf "Error: entry not extensible: \"%s\"\n" + entry.ename; + flush stderr; + failwith "Grammar.extend") + in + if rules = [] + then elev + else + (let (levs1, make_lev, levs2) = + get_level entry position elev in + let (levs, _) = + List.fold_left + (fun (levs, make_lev) (lname, assoc, level) -> + let lev = make_lev lname assoc in + let lev = + List.fold_left + (fun lev (symbols, action) -> + let symbols = + List.map (change_to_self entry) + symbols + in + (List.iter (check_gram entry) symbols; + let (e1, symbols) = + get_initial symbols + in + (insert_tokens entry.egram symbols; + insert_level entry e1 symbols + action lev))) + lev level + in ((lev :: levs), empty_lev)) + ([], make_lev) rules + in levs1 @ ((List.rev levs) @ levs2)) + let extend entry (position, rules) = + let elev = levels_of_rules entry position rules + in + (entry.edesc <- Dlevels elev; + entry.estart <- + (fun lev c strm -> + let f = Parser.start_parser_of_entry entry + in (entry.estart <- f; f lev c strm)); + entry.econtinue <- + fun lev bp a c strm -> + let f = Parser.continue_parser_of_entry entry + in (entry.econtinue <- f; f lev bp a c strm)) + end + end + module Delete = + struct + module Make (Structure : Structure.S) = + struct + module Tools = Tools.Make(Structure) + module Parser = Parser.Make(Structure) + open Structure + let delete_rule_in_tree entry = + let rec delete_in_tree symbols tree = + match (symbols, tree) with + | (s :: sl, Node n) -> + if Tools.logically_eq_symbols entry s n.node + then delete_son sl n + else + (match delete_in_tree symbols n.brother with + | Some ((dsl, t)) -> + Some + ((dsl, + (Node + { + + node = n.node; + son = n.son; + brother = t; + }))) + | None -> None) + | (_ :: _, _) -> None + | ([], Node n) -> + (match delete_in_tree [] n.brother with + | Some ((dsl, t)) -> + Some + ((dsl, + (Node + { + + node = n.node; + son = n.son; + brother = t; + }))) + | None -> None) + | ([], DeadEnd) -> None + | ([], LocAct (_, [])) -> Some (((Some []), DeadEnd)) + | ([], LocAct (_, (action :: list))) -> + Some ((None, (LocAct (action, list)))) + and delete_son sl n = + match delete_in_tree sl n.son with + | Some ((Some dsl, DeadEnd)) -> + Some (((Some (n.node :: dsl)), (n.brother))) + | Some ((Some dsl, t)) -> + let t = + Node + { node = n.node; son = t; brother = n.brother; } + in Some (((Some (n.node :: dsl)), t)) + | Some ((None, t)) -> + let t = + Node + { node = n.node; son = t; brother = n.brother; } + in Some ((None, t)) + | None -> None + in delete_in_tree + let rec decr_keyw_use gram = + function + | Skeyword kwd -> removing gram kwd + | Smeta (_, sl, _) -> List.iter (decr_keyw_use gram) sl + | Slist0 s -> decr_keyw_use gram s + | Slist1 s -> decr_keyw_use gram s + | Slist0sep (s1, s2) -> + (decr_keyw_use gram s1; decr_keyw_use gram s2) + | Slist1sep (s1, s2) -> + (decr_keyw_use gram s1; decr_keyw_use gram s2) + | Sopt s -> decr_keyw_use gram s + | Stree t -> decr_keyw_use_in_tree gram t + | Sself | Snext | Snterm _ | Snterml (_, _) | Stoken _ -> + () + and decr_keyw_use_in_tree gram = + function + | DeadEnd | LocAct (_, _) -> () + | Node n -> + (decr_keyw_use gram n.node; + decr_keyw_use_in_tree gram n.son; + decr_keyw_use_in_tree gram n.brother) + let rec delete_rule_in_suffix entry symbols = + function + | lev :: levs -> + (match delete_rule_in_tree entry symbols lev.lsuffix + with + | Some ((dsl, t)) -> + ((match dsl with + | Some dsl -> + List.iter (decr_keyw_use entry.egram) dsl + | None -> ()); + (match t with + | DeadEnd when lev.lprefix == DeadEnd -> levs + | _ -> + let lev = + { + + assoc = lev.assoc; + lname = lev.lname; + lsuffix = t; + lprefix = lev.lprefix; + } + in lev :: levs)) + | None -> + let levs = + delete_rule_in_suffix entry symbols levs + in lev :: levs) + | [] -> raise Not_found + let rec delete_rule_in_prefix entry symbols = + function + | lev :: levs -> + (match delete_rule_in_tree entry symbols lev.lprefix + with + | Some ((dsl, t)) -> + ((match dsl with + | Some dsl -> + List.iter (decr_keyw_use entry.egram) dsl + | None -> ()); + (match t with + | DeadEnd when lev.lsuffix == DeadEnd -> levs + | _ -> + let lev = + { + + assoc = lev.assoc; + lname = lev.lname; + lsuffix = lev.lsuffix; + lprefix = t; + } + in lev :: levs)) + | None -> + let levs = + delete_rule_in_prefix entry symbols levs + in lev :: levs) + | [] -> raise Not_found + let rec delete_rule_in_level_list entry symbols levs = + match symbols with + | Sself :: symbols -> + delete_rule_in_suffix entry symbols levs + | Snterm e :: symbols when e == entry -> + delete_rule_in_suffix entry symbols levs + | _ -> delete_rule_in_prefix entry symbols levs + let delete_rule entry sl = + match entry.edesc with + | Dlevels levs -> + let levs = delete_rule_in_level_list entry sl levs + in + (entry.edesc <- Dlevels levs; + entry.estart <- + (fun lev c strm -> + let f = Parser.start_parser_of_entry entry + in (entry.estart <- f; f lev c strm)); + entry.econtinue <- + (fun lev bp a c strm -> + let f = Parser.continue_parser_of_entry entry + in (entry.econtinue <- f; f lev bp a c strm))) + | Dparser _ -> () + end + end + module Fold : + sig + module Make (Structure : Structure.S) : + sig + open Structure + val sfold0 : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) fold + val sfold1 : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) fold + val sfold0sep : ('a -> 'b -> 'b) -> 'b -> (_, 'a, 'b) foldsep + end + end = + struct + module Make (Structure : Structure.S) = + struct + open Structure + open Format + module Parse = Parser.Make(Structure) + module Fail = Failed.Make(Structure) + open Sig.Grammar + module Stream = + struct + include Stream + let junk strm = Context.junk strm + let count strm = Context.bp strm + end + let sfold0 f e _entry _symbl psymb = + let rec fold accu (__strm : _ Stream.t) = + match try Some (psymb __strm) + with | Stream.Failure -> None + with + | Some a -> fold (f a accu) __strm + | _ -> accu + in fun (__strm : _ Stream.t) -> fold e __strm + let sfold1 f e _entry _symbl psymb = + let rec fold accu (__strm : _ Stream.t) = + match try Some (psymb __strm) + with | Stream.Failure -> None + with + | Some a -> fold (f a accu) __strm + | _ -> accu + in + fun (__strm : _ Stream.t) -> + let a = psymb __strm + in + try fold (f a e) __strm + with | Stream.Failure -> raise (Stream.Error "") + let sfold0sep f e entry symbl psymb psep = + let failed = + function + | [ symb; sep ] -> Fail.symb_failed_txt entry sep symb + | _ -> "failed" in + let rec kont accu (__strm : _ Stream.t) = + match try Some (psep __strm) + with | Stream.Failure -> None + with + | Some () -> + let a = + (try psymb __strm + with + | Stream.Failure -> + raise (Stream.Error (failed symbl))) + in kont (f a accu) __strm + | _ -> accu + in + fun (__strm : _ Stream.t) -> + match try Some (psymb __strm) + with | Stream.Failure -> None + with + | Some a -> kont (f a e) __strm + | _ -> e + let sfold1sep f e entry symbl psymb psep = + let failed = + function + | [ symb; sep ] -> Fail.symb_failed_txt entry sep symb + | _ -> "failed" in + let parse_top = + function + | [ symb; _ ] -> Parse.parse_top_symb entry symb + | _ -> raise Stream.Failure in + let rec kont accu (__strm : _ Stream.t) = + match try Some (psep __strm) + with | Stream.Failure -> None + with + | Some () -> + let a = + (try + try psymb __strm + with + | Stream.Failure -> + let a = + (try parse_top symbl __strm + with + | Stream.Failure -> + raise (Stream.Error (failed symbl))) + in Obj.magic a + with | Stream.Failure -> raise (Stream.Error "")) + in kont (f a accu) __strm + | _ -> accu + in + fun (__strm : _ Stream.t) -> + let a = psymb __strm in kont (f a e) __strm + end + end + module Entry = + struct + module Make (Structure : Structure.S) = + struct + module Dump = Print.MakeDump(Structure) + module Print = Print.Make(Structure) + module Tools = Tools.Make(Structure) + open Format + open Structure + type 'a t = internal_entry + let name e = e.ename + let print ppf e = fprintf ppf "%a@\n" Print.entry e + let dump ppf e = fprintf ppf "%a@\n" Dump.entry e + let mk g n = + { + + egram = g; + ename = n; + estart = Tools.empty_entry n; + econtinue = + (fun _ _ _ _ (__strm : _ Stream.t) -> + raise Stream.Failure); + edesc = Dlevels []; + } + let action_parse entry ts : Action.t = + Context.call_with_ctx ts + (fun c -> + try entry.estart 0 c (Context.stream c) + with + | Stream.Failure -> + Loc.raise (Context.loc_ep c) + (Stream.Error + ("illegal begin of " ^ entry.ename)) + | (Loc.Exc_located (_, _) as exc) -> raise exc + | exc -> Loc.raise (Context.loc_ep c) exc) + let lex entry loc cs = entry.egram.glexer loc cs + let lex_string entry loc str = + lex entry loc (Stream.of_string str) + let filter entry ts = + Token.Filter.filter (get_filter entry.egram) ts + let parse_tokens_after_filter entry ts = + Action.get (action_parse entry ts) + let parse_tokens_before_filter entry ts = + parse_tokens_after_filter entry (filter entry ts) + let parse entry loc cs = + parse_tokens_before_filter entry (lex entry loc cs) + let parse_string entry loc str = + parse_tokens_before_filter entry (lex_string entry loc str) + let of_parser g n (p : (Token.t * Loc.t) Stream.t -> 'a) : + 'a t = + { + + egram = g; + ename = n; + estart = (fun _ _ ts -> Action.mk (p ts)); + econtinue = + (fun _ _ _ _ (__strm : _ Stream.t) -> + raise Stream.Failure); + edesc = Dparser (fun ts -> Action.mk (p ts)); + } + let setup_parser e (p : (Token.t * Loc.t) Stream.t -> 'a) = + let f ts = Action.mk (p ts) + in + (e.estart <- (fun _ _ -> f); + e.econtinue <- + (fun _ _ _ _ (__strm : _ Stream.t) -> + raise Stream.Failure); + e.edesc <- Dparser f) + let clear e = + (e.estart <- + (fun _ _ (__strm : _ Stream.t) -> raise Stream.Failure); + e.econtinue <- + (fun _ _ _ _ (__strm : _ Stream.t) -> + raise Stream.Failure); + e.edesc <- Dlevels []) + let obj x = x + end + end + module Static = + struct + module Make (Lexer : Sig.Lexer) : + Sig.Grammar.Static with module Loc = Lexer.Loc + and module Token = Lexer.Token = + struct + module Structure = Structure.Make(Lexer) + module Delete = Delete.Make(Structure) + module Insert = Insert.Make(Structure) + module Fold = Fold.Make(Structure) + include Structure + let gram = + let gkeywords = Hashtbl.create 301 + in + { + + gkeywords = gkeywords; + gfilter = Token.Filter.mk (Hashtbl.mem gkeywords); + glexer = Lexer.mk (); + warning_verbose = ref true; + error_verbose = Camlp4_config.verbose; + } + module Entry = + struct + module E = Entry.Make(Structure) + type 'a t = 'a E.t + let mk = E.mk gram + let of_parser name strm = E.of_parser gram name strm + let setup_parser = E.setup_parser + let name = E.name + let print = E.print + let clear = E.clear + let dump = E.dump + let obj x = x + end + let get_filter () = gram.gfilter + let lex loc cs = gram.glexer loc cs + let lex_string loc str = lex loc (Stream.of_string str) + let filter ts = Token.Filter.filter gram.gfilter ts + let parse_tokens_after_filter entry ts = + Entry.E.parse_tokens_after_filter entry ts + let parse_tokens_before_filter entry ts = + parse_tokens_after_filter entry (filter ts) + let parse entry loc cs = + parse_tokens_before_filter entry (lex loc cs) + let parse_string entry loc str = + parse_tokens_before_filter entry (lex_string loc str) + let delete_rule = Delete.delete_rule + let srules e rl = + let t = + List.fold_left + (fun tree (symbols, action) -> + Insert.insert_tree e symbols action tree) + DeadEnd rl + in Stree t + let sfold0 = Fold.sfold0 + let sfold1 = Fold.sfold1 + let sfold0sep = Fold.sfold0sep + let extend = Insert.extend + end + end + module Dynamic = + struct + module Make (Lexer : Sig.Lexer) : + Sig.Grammar.Dynamic with module Loc = Lexer.Loc + and module Token = Lexer.Token = + struct + module Structure = Structure.Make(Lexer) + module Delete = Delete.Make(Structure) + module Insert = Insert.Make(Structure) + module Entry = Entry.Make(Structure) + module Fold = Fold.Make(Structure) + include Structure + let mk () = + let gkeywords = Hashtbl.create 301 + in + { + + gkeywords = gkeywords; + gfilter = Token.Filter.mk (Hashtbl.mem gkeywords); + glexer = Lexer.mk (); + warning_verbose = ref true; + error_verbose = Camlp4_config.verbose; + } + let get_filter g = g.gfilter + let lex g loc cs = g.glexer loc cs + let lex_string g loc str = lex g loc (Stream.of_string str) + let filter g ts = Token.Filter.filter g.gfilter ts + let parse_tokens_after_filter entry ts = + Entry.parse_tokens_after_filter entry ts + let parse_tokens_before_filter entry ts = + parse_tokens_after_filter entry (filter entry.egram ts) + let parse entry loc cs = + parse_tokens_before_filter entry (lex entry.egram loc cs) + let parse_string entry loc str = + parse_tokens_before_filter entry + (lex_string entry.egram loc str) + let delete_rule = Delete.delete_rule + let srules e rl = + let t = + List.fold_left + (fun tree (symbols, action) -> + Insert.insert_tree e symbols action tree) + DeadEnd rl + in Stree t + let sfold0 = Fold.sfold0 + let sfold1 = Fold.sfold1 + let sfold0sep = Fold.sfold0sep + let extend = Insert.extend + end + end + end + end +module Printers = + struct + module DumpCamlp4Ast : + sig + module Id : Sig.Id + module Make (Syntax : Sig.Syntax) : + Sig.Printer with module Ast = Syntax.Ast + end = + struct + module Id = + struct + let name = "Camlp4Printers.DumpCamlp4Ast" + let version = + "$Id: DumpCamlp4Ast.ml,v 1.4 2006/10/03 08:54:08 ertai Exp $" + end + module Make (Syntax : Sig.Syntax) : + Sig.Printer with module Ast = Syntax.Ast = + struct + include Syntax + let with_open_out_file x f = + match x with + | Some file -> + let oc = open_out_bin file + in (f oc; flush oc; close_out oc) + | None -> + (set_binary_mode_out stdout true; f stdout; flush stdout) + let dump_ast magic ast oc = + (output_string oc magic; output_value oc ast) + let print_interf ?input_file:(_) ?output_file ast = + with_open_out_file output_file + (dump_ast Camlp4_config.camlp4_ast_intf_magic_number ast) + let print_implem ?input_file:(_) ?output_file ast = + with_open_out_file output_file + (dump_ast Camlp4_config.camlp4_ast_impl_magic_number ast) + end + end + module DumpOCamlAst : + sig + module Id : Sig.Id + module Make (Syntax : Sig.Camlp4Syntax) : + Sig.Printer with module Ast = Syntax.Ast + end = + struct + module Id : Sig.Id = + struct + let name = "Camlp4Printers.DumpOCamlAst" + let version = + "$Id: DumpOCamlAst.ml,v 1.4 2006/10/03 08:54:08 ertai Exp $" + end + module Make (Syntax : Sig.Camlp4Syntax) : + Sig.Printer with module Ast = Syntax.Ast = + struct + include Syntax + module Ast2pt = Struct.Camlp4Ast2OCamlAst.Make(Ast) + let with_open_out_file x f = + match x with + | Some file -> + let oc = open_out_bin file + in (f oc; flush oc; close_out oc) + | None -> + (set_binary_mode_out stdout true; f stdout; flush stdout) + let dump_pt magic fname pt oc = + (output_string oc magic; + output_value oc (if fname = "-" then "" else fname); + output_value oc pt) + let print_interf ?(input_file = "-") ?output_file ast = + let pt = Ast2pt.sig_item ast + in + with_open_out_file output_file + (dump_pt Camlp4_config.ocaml_ast_intf_magic_number + input_file pt) + let print_implem ?(input_file = "-") ?output_file ast = + let pt = Ast2pt.str_item ast + in + with_open_out_file output_file + (dump_pt Camlp4_config.ocaml_ast_impl_magic_number + input_file pt) + end + end + module Null : + sig + module Id : Sig.Id + module Make (Syntax : Sig.Syntax) : + Sig.Printer with module Ast = Syntax.Ast + end = + struct + module Id = + struct + let name = "Camlp4.Printers.Null" + let version = + "$Id: Null.ml,v 1.1 2006/10/03 08:54:08 ertai Exp $" + end + module Make (Syntax : Sig.Syntax) = + struct + include Syntax + let print_interf ?input_file:(_) ?output_file:(_) _ = () + let print_implem ?input_file:(_) ?output_file:(_) _ = () + end + end + module OCaml : + sig + module Id : Sig.Id + module Make (Syntax : Sig.Camlp4Syntax) : + sig + open Format + include Sig.Camlp4Syntax with module Loc = Syntax.Loc + and module Warning = Syntax.Warning + and module Token = Syntax.Token and module Ast = Syntax.Ast + and module Gram = Syntax.Gram + val list' : + (formatter -> 'a -> unit) -> + ('b, formatter, unit) format -> + (unit, formatter, unit) format -> + formatter -> 'a list -> unit + val list : + (formatter -> 'a -> unit) -> + ('b, formatter, unit) format -> formatter -> 'a list -> unit + val lex_string : string -> Token.t + val is_infix : string -> bool + val is_keyword : string -> bool + val ocaml_char : string -> string + val get_expr_args : + Ast.expr -> Ast.expr list -> (Ast.expr * (Ast.expr list)) + val get_patt_args : + Ast.patt -> Ast.patt list -> (Ast.patt * (Ast.patt list)) + val get_ctyp_args : + Ast.ctyp -> Ast.ctyp list -> (Ast.ctyp * (Ast.ctyp list)) + val expr_fun_args : Ast.expr -> ((Ast.patt list) * Ast.expr) + class printer : + ?curry_constr: bool -> + ?comments: bool -> + unit -> + object ('a) + method interf : formatter -> Ast.sig_item -> unit + method implem : formatter -> Ast.str_item -> unit + method sig_item : formatter -> Ast.sig_item -> unit + method str_item : formatter -> Ast.str_item -> unit + val pipe : bool + val semi : bool + val semisep : string + val value_val : string + val value_let : string + method anti : formatter -> string -> unit + method class_declaration : + formatter -> Ast.class_expr -> unit + method class_expr : formatter -> Ast.class_expr -> unit + method class_sig_item : + formatter -> Ast.class_sig_item -> unit + method class_str_item : + formatter -> Ast.class_str_item -> unit + method class_type : formatter -> Ast.class_type -> unit + method constrain : + formatter -> (Ast.ctyp * Ast.ctyp) -> unit + method ctyp : formatter -> Ast.ctyp -> unit + method ctyp1 : formatter -> Ast.ctyp -> unit + method constructor_type : formatter -> Ast.ctyp -> unit + method dot_expr : formatter -> Ast.expr -> unit + method expr : formatter -> Ast.expr -> unit + method expr_list : formatter -> Ast.expr list -> unit + method expr_list_cons : + bool -> formatter -> Ast.expr -> unit + method functor_arg : + formatter -> (string * Ast.module_type) -> unit + method functor_args : + formatter -> (string * Ast.module_type) list -> unit + method ident : formatter -> Ast.ident -> unit + method intlike : formatter -> string -> unit + method binding : formatter -> Ast.binding -> unit + method record_binding : + formatter -> Ast.binding -> unit + method match_case : formatter -> Ast.match_case -> unit + method match_case_aux : + formatter -> Ast.match_case -> unit + method mk_expr_list : + Ast.expr -> ((Ast.expr list) * (Ast.expr option)) + method mk_patt_list : + Ast.patt -> ((Ast.patt list) * (Ast.patt option)) + method module_expr : + formatter -> Ast.module_expr -> unit + method module_expr_get_functor_args : + (string * Ast.module_type) list -> + Ast.module_expr -> + (((string * Ast.module_type) list) * Ast. + module_expr * (Ast.module_type option)) + method module_rec_binding : + formatter -> Ast.module_binding -> unit + method module_type : + formatter -> Ast.module_type -> unit + method mutable_flag : + formatter -> Ast.meta_bool -> unit + method direction_flag : + formatter -> Ast.meta_bool -> unit + method rec_flag : formatter -> Ast.meta_bool -> unit + method flag : + formatter -> Ast.meta_bool -> string -> unit + method node : formatter -> 'b -> ('b -> Loc.t) -> unit + method object_dup : + formatter -> (string * Ast.expr) list -> unit + method patt : formatter -> Ast.patt -> unit + method patt1 : formatter -> Ast.patt -> unit + method patt2 : formatter -> Ast.patt -> unit + method patt3 : formatter -> Ast.patt -> unit + method patt4 : formatter -> Ast.patt -> unit + method patt5 : formatter -> Ast.patt -> unit + method patt_expr_fun_args : + formatter -> (Ast.patt * Ast.expr) -> unit + method patt_class_expr_fun_args : + formatter -> (Ast.patt * Ast.class_expr) -> unit + method print_comments_before : + Loc.t -> formatter -> unit + method private_flag : + formatter -> Ast.meta_bool -> unit + method virtual_flag : + formatter -> Ast.meta_bool -> unit + method quoted_string : formatter -> string -> unit + method raise_match_failure : formatter -> Loc.t -> unit + method reset : 'a + method reset_semi : 'a + method semisep : string + method set_comments : bool -> 'a + method set_curry_constr : bool -> 'a + method set_loc_and_comments : 'a + method set_semisep : string -> 'a + method simple_ctyp : formatter -> Ast.ctyp -> unit + method simple_expr : formatter -> Ast.expr -> unit + method simple_patt : formatter -> Ast.patt -> unit + method seq : formatter -> Ast.expr -> unit + method string : formatter -> string -> unit + method sum_type : formatter -> Ast.ctyp -> unit + method type_params : formatter -> Ast.ctyp list -> unit + method class_params : formatter -> Ast.ctyp -> unit + method under_pipe : 'a + method under_semi : 'a + method var : formatter -> string -> unit + method with_constraint : + formatter -> Ast.with_constr -> unit + end + val with_outfile : + string option -> (formatter -> 'a -> unit) -> 'a -> unit + val print : + string option -> + (printer -> formatter -> 'a -> unit) -> 'a -> unit + val print_interf : + ?input_file: string -> + ?output_file: string -> Ast.sig_item -> unit + val print_implem : + ?input_file: string -> + ?output_file: string -> Ast.str_item -> unit + end + module MakeMore (Syntax : Sig.Camlp4Syntax) : + Sig.Printer with module Ast = Syntax.Ast + end = + struct + open Format + module Id = + struct + let name = "Camlp4.Printers.OCaml" + let version = + "$Id: OCaml.ml,v 1.19 2006/10/10 22:32:43 ertai Exp $" + end + module Make (Syntax : Sig.Camlp4Syntax) = + struct + include Syntax + let pp = fprintf + let cut f = fprintf f "@ " + let list' elt sep sep' f = + let rec loop = + function + | [] -> () + | x :: xs -> (pp f sep; elt f x; pp f sep'; loop xs) + in + function + | [] -> () + | [ x ] -> (elt f x; pp f sep') + | x :: xs -> (elt f x; pp f sep'; loop xs) + let list elt sep f = + let rec loop = + function | [] -> () | x :: xs -> (pp f sep; elt f x; loop xs) + in + function + | [] -> () + | [ x ] -> elt f x + | x :: xs -> (elt f x; loop xs) + module CommentFilter = Struct.CommentFilter.Make(Token) + let comment_filter = CommentFilter.mk () + let _ = CommentFilter.define (Gram.get_filter ()) comment_filter + module StringSet = Set.Make(String) + let is_infix = + let infixes = + List.fold_right StringSet.add + [ "=="; "!="; "+"; "-"; "+."; "-."; "*"; "*."; "/"; "/."; + "**"; "="; "<>"; "<"; ">"; "<="; ">="; "^"; "^^"; "@"; + "&&"; "||"; "asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; + "mod"; "or" ] + StringSet.empty + in fun s -> StringSet.mem s infixes + let is_keyword = + let keywords = + List.fold_right StringSet.add + [ "and"; "as"; "assert"; "asr"; "begin"; "class"; + "constraint"; "do"; "done"; "downto"; "else"; "end"; + "exception"; "external"; "false"; "for"; "fun"; + "function"; "functor"; "if"; "in"; "include"; "inherit"; + "initializer"; "land"; "lazy"; "let"; "lor"; "lsl"; + "lsr"; "lxor"; "match"; "method"; "mod"; "module"; + "mutable"; "new"; "object"; "of"; "open"; "or"; "parser"; + "private"; "rec"; "sig"; "struct"; "then"; "to"; "true"; + "try"; "type"; "val"; "virtual"; "when"; "while"; "with" ] + StringSet.empty + in fun s -> StringSet.mem s keywords + module Lexer = Struct.Lexer.Make(Token) + let _ = let module M = ErrorHandler.Register(Lexer.Error) in () + open Sig + let lexer s = + Lexer.from_string ~quotations: !Camlp4_config.quotations Loc. + ghost s + let lex_string str = + try + let (__strm : _ Stream.t) = lexer str + in + match Stream.peek __strm with + | Some ((tok, _)) -> + (Stream.junk __strm; + (match Stream.peek __strm with + | Some ((EOI, _)) -> (Stream.junk __strm; tok) + | _ -> raise (Stream.Error ""))) + | _ -> raise Stream.Failure + with + | Stream.Failure -> + failwith + (sprintf + "Cannot print %S this string contains more than one token" + str) + | Lexer.Error.E exn -> + failwith + (sprintf + "Cannot print %S this identifier does not respect OCaml lexing rules (%s)" + str (Lexer.Error.to_string exn)) + let ocaml_char = function | "'" -> "\\'" | c -> c + let rec get_expr_args a al = + match a with + | Ast.ExApp (_, a1, a2) -> get_expr_args a1 (a2 :: al) + | _ -> (a, al) + let rec get_patt_args a al = + match a with + | Ast.PaApp (_, a1, a2) -> get_patt_args a1 (a2 :: al) + | _ -> (a, al) + let rec get_ctyp_args a al = + match a with + | Ast.TyApp (_, a1, a2) -> get_ctyp_args a1 (a2 :: al) + | _ -> (a, al) + let is_irrefut_patt = Ast.is_irrefut_patt + let rec expr_fun_args = + function + | (Ast.ExFun (_, (Ast.McArr (_, p, (Ast.ExNil _), e))) as ge) + -> + if is_irrefut_patt p + then (let (pl, e) = expr_fun_args e in ((p :: pl), e)) + else ([], ge) + | ge -> ([], ge) + let rec class_expr_fun_args = + function + | (Ast.CeFun (_, p, ce) as ge) -> + if is_irrefut_patt p + then + (let (pl, ce) = class_expr_fun_args ce in ((p :: pl), ce)) + else ([], ge) + | ge -> ([], ge) + let rec do_print_comments_before loc f (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some ((comm, comm_loc)) when Loc.strictly_before comm_loc loc + -> + (Stream.junk __strm; + let s = __strm in + let () = f comm comm_loc + in do_print_comments_before loc f s) + | _ -> () + class printer ?curry_constr:(init_curry_constr = false) + ?(comments = true) () = + object (o) + val pipe = false + val semi = false + method under_pipe = {< pipe = true; >} + method under_semi = {< semi = true; >} + method reset_semi = {< semi = false; >} + method reset = {< pipe = false; semi = false; >} + val semisep = ";;" + val andsep = + ("@]@ @[<2>and@ " : (unit, formatter, unit) format) + val value_val = "val" + val value_let = "let" + val mode = if comments then `comments else `no_comments + val curry_constr = init_curry_constr + val var_conversion = false + method semisep = semisep + method set_semisep = fun s -> {< semisep = s; >} + method set_comments = + fun b -> + {< mode = if b then `comments else `no_comments; >} + method set_loc_and_comments = + {< mode = `loc_and_comments; >} + method set_curry_constr = fun b -> {< curry_constr = b; >} + method print_comments_before = + fun loc f -> + match mode with + | `comments -> + do_print_comments_before loc + (fun c _ -> pp f "%s@ " c) + (CommentFilter.take_stream comment_filter) + | `loc_and_comments -> + let () = pp f "(*loc: %a*)@ " Loc.dump loc + in + do_print_comments_before loc + (fun s -> pp f "%s(*comm_loc: %a*)@ " s Loc.dump) + (CommentFilter.take_stream comment_filter) + | _ -> () + method var = + fun f -> + function + | "" -> pp f "$lid:\"\"$" + | "[]" -> pp f "[]" + | "()" -> pp f "()" + | " True" -> pp f "True" + | " False" -> pp f "False" + | v -> + (match (var_conversion, v) with + | (true, "val") -> pp f "contents" + | (true, "True") -> pp f "true" + | (true, "False") -> pp f "false" + | _ -> + (match lex_string v with + | LIDENT s | UIDENT s | ESCAPED_IDENT s when + is_keyword s -> pp f "%s__" s + | SYMBOL s -> pp f "( %s )" s + | LIDENT s | UIDENT s | ESCAPED_IDENT s -> + pp_print_string f s + | tok -> + failwith + (sprintf + "Bad token used as an identifier: %s" + (Token.to_string tok)))) + method type_params = + fun f -> + function + | [] -> () + | [ x ] -> pp f "%a@ " o#ctyp x + | l -> pp f "@[<1>(%a)@]@ " (list o#ctyp ",@ ") l + method class_params = + fun f -> + function + | Ast.TyCom (_, t1, t2) -> + pp f "@[<1>%a,@ %a@]" o#class_params t1 + o#class_params t2 + | x -> o#ctyp f x + method mutable_flag = fun f b -> o#flag f b "mutable" + method rec_flag = fun f b -> o#flag f b "rec" + method virtual_flag = fun f b -> o#flag f b "virtual" + method private_flag = fun f b -> o#flag f b "private" + method flag = + fun f b n -> + match b with + | Ast.BTrue -> (pp_print_string f n; pp f "@ ") + | Ast.BFalse -> () + | Ast.BAnt s -> o#anti f s + method anti = fun f s -> pp f "$%s$" s + method seq = + fun f -> + function + | Ast.ExSem (_, e1, e2) -> + pp f "%a;@ %a" o#under_semi#seq e1 o#seq e2 + | Ast.ExSeq (_, e) -> o#seq f e + | e -> o#expr f e + method match_case = + fun f -> + function + | Ast.McNil _loc -> + pp f "@[<2>_@ ->@ %a@]" o#raise_match_failure _loc + | a -> o#match_case_aux f a + method match_case_aux = + fun f -> + function + | Ast.McNil _ -> () + | Ast.McAnt (_, s) -> o#anti f s + | Ast.McOr (_, a1, a2) -> + pp f "%a%a" o#match_case_aux a1 o#match_case_aux a2 + | Ast.McArr (_, p, (Ast.ExNil _), e) -> + pp f "@ | @[<2>%a@ ->@ %a@]" o#patt p + o#under_pipe#expr e + | Ast.McArr (_, p, w, e) -> + pp f "@ | @[<2>%a@ when@ %a@ ->@ %a@]" o#patt p + o#under_pipe#expr w o#under_pipe#expr e + method binding = + fun f bi -> + let () = o#node f bi Ast.loc_of_binding + in + match bi with + | Ast.BiNil _ -> () + | Ast.BiAnd (_, b1, b2) -> + (o#binding f b1; pp f andsep; o#binding f b2) + | Ast.BiEq (_, p, e) -> + let (pl, e) = + (match p with + | Ast.PaTyc (_, _, _) -> ([], e) + | _ -> expr_fun_args e) + in + (match (p, e) with + | (Ast.PaId (_, (Ast.IdLid (_, _))), + Ast.ExTyc (_, e, t)) -> + pp f "%a :@ %a =@ %a" + (list o#simple_patt "@ ") (p :: pl) + o#ctyp t o#expr e + | _ -> + pp f "%a @[<0>%a=@]@ %a" o#simple_patt p + (list' o#simple_patt "" "@ ") pl o#expr e) + | Ast.BiSem (_, _, _) -> assert false + | Ast.BiAnt (_, s) -> o#anti f s + method record_binding = + fun f bi -> + let () = o#node f bi Ast.loc_of_binding + in + match bi with + | Ast.BiNil _ -> () + | Ast.BiEq (_, p, e) -> + pp f "@ @[<2>%a =@ %a@];" o#simple_patt p o#expr e + | Ast.BiSem (_, b1, b2) -> + (o#under_semi#record_binding f b1; + o#under_semi#record_binding f b2) + | Ast.BiAnd (_, _, _) -> assert false + | Ast.BiAnt (_, s) -> o#anti f s + method object_dup = + fun f -> + list + (fun f (s, e) -> + pp f "@[<2>%a =@ %a@]" o#var s o#expr e) + ";@ " f + method mk_patt_list = + function + | Ast.PaApp (_, + (Ast.PaApp (_, (Ast.PaId (_, (Ast.IdUid (_, "::")))), + p1)), + p2) -> + let (pl, c) = o#mk_patt_list p2 in ((p1 :: pl), c) + | Ast.PaId (_, (Ast.IdUid (_, "[]"))) -> ([], None) + | p -> ([], (Some p)) + method mk_expr_list = + function + | Ast.ExApp (_, + (Ast.ExApp (_, (Ast.ExId (_, (Ast.IdUid (_, "::")))), + e1)), + e2) -> + let (el, c) = o#mk_expr_list e2 in ((e1 :: el), c) + | Ast.ExId (_, (Ast.IdUid (_, "[]"))) -> ([], None) + | e -> ([], (Some e)) + method expr_list = + fun f -> + function + | [] -> pp f "[]" + | [ e ] -> pp f "[ %a ]" o#expr e + | el -> pp f "@[<2>[ %a@] ]" (list o#expr ";@ ") el + method expr_list_cons = + fun simple f e -> + let (el, c) = o#mk_expr_list e + in + match c with + | None -> o#expr_list f el + | Some x -> + (if simple + then pp f "@[<2>(%a)@]" + else pp f "@[<2>%a@]") (list o#dot_expr " ::@ ") + (el @ [ x ]) + method patt_expr_fun_args = + fun f (p, e) -> + let (pl, e) = expr_fun_args e + in + pp f "%a@ ->@ %a" (list o#patt "@ ") (p :: pl) o#expr e + method patt_class_expr_fun_args = + fun f (p, ce) -> + let (pl, ce) = class_expr_fun_args ce + in + pp f "%a =@]@ %a" (list o#patt "@ ") (p :: pl) + o#class_expr ce + method constrain = + fun f (t1, t2) -> + pp f "@[<2>constraint@ %a =@ %a@]" o#ctyp t1 o#ctyp t2 + method sum_type = + fun f t -> (pp_print_string f "| "; o#ctyp f t) + method string = fun f -> pp f "%s" + method quoted_string = fun f -> pp f "%S" + method intlike = + fun f s -> + if s.[0] = '-' then pp f "(%s)" s else pp f "%s" s + method module_expr_get_functor_args = + fun accu -> + function + | Ast.MeFun (_, s, mt, me) -> + o#module_expr_get_functor_args ((s, mt) :: accu) me + | Ast.MeTyc (_, me, mt) -> + ((List.rev accu), me, (Some mt)) + | me -> ((List.rev accu), me, None) + method functor_args = fun f -> list o#functor_arg "@ " f + method functor_arg = + fun f (s, mt) -> + pp f "@[<2>(%a :@ %a)@]" o#var s o#module_type mt + method module_rec_binding = + fun f -> + function + | Ast.MbNil _ -> () + | Ast.MbColEq (_, s, mt, me) -> + pp f "@[<2>%a :@ %a =@ %a@]" o#var s o#module_type mt + o#module_expr me + | Ast.MbCol (_, s, mt) -> + pp f "@[<2>%a :@ %a@]" o#var s o#module_type mt + | Ast.MbAnd (_, mb1, mb2) -> + (o#module_rec_binding f mb1; + pp f andsep; + o#module_rec_binding f mb2) + | Ast.MbAnt (_, s) -> o#anti f s + method class_declaration = + fun f -> + function + | Ast.CeTyc (_, ce, ct) -> + pp f "%a :@ %a" o#class_expr ce o#class_type ct + | ce -> o#class_expr f ce + method raise_match_failure = + fun f _loc -> + let n = Loc.file_name _loc in + let l = Loc.start_line _loc in + let c = (Loc.start_off _loc) - (Loc.start_bol _loc) + in + o#expr f + (Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "raise")), + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdUid (_loc, "Match_failure")), + Ast.ExStr (_loc, Ast.safe_string_escaped n)), + Ast.ExInt (_loc, string_of_int l)), + Ast.ExInt (_loc, string_of_int c)))) + method node : 'a. formatter -> 'a -> ('a -> Loc.t) -> unit = + fun f node loc_of_node -> + o#print_comments_before (loc_of_node node) f + method ident = + fun f i -> + let () = o#node f i Ast.loc_of_ident + in + match i with + | Ast.IdAcc (_, i1, i2) -> + pp f "%a.@,%a" o#ident i1 o#ident i2 + | Ast.IdApp (_, i1, i2) -> + pp f "%a@,(%a)" o#ident i1 o#ident i2 + | Ast.IdAnt (_, s) -> o#anti f s + | Ast.IdLid (_, s) | Ast.IdUid (_, s) -> o#var f s + method private var_ident = + {< var_conversion = true; >}#ident + method expr = + fun f e -> + let () = o#node f e Ast.loc_of_expr + in + match e with + | (Ast.ExLet (_, _, _, _) | Ast.ExLmd (_, _, _, _) as + e) when semi -> pp f "(%a)" o#reset#expr e + | (Ast.ExMat (_, _, _) | Ast.ExTry (_, _, _) | + Ast.ExFun (_, _) + as e) when pipe || semi -> + pp f "(%a)" o#reset#expr e + | Ast.ExApp (_, (Ast.ExId (_, (Ast.IdLid (_, "~-")))), + x) -> pp f "@[<2>-@,%a@]" o#expr x + | Ast.ExApp (_, (Ast.ExId (_, (Ast.IdLid (_, "~-.")))), + x) -> pp f "@[<2>-.@,%a@]" o#expr x + | Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExId (_, (Ast.IdUid (_, "::")))), _)), + _) -> o#expr_list_cons false f e + | Ast.ExApp (_loc, + (Ast.ExApp (_, (Ast.ExId (_, (Ast.IdLid (_, n)))), + x)), + y) when is_infix n -> + pp f "@[<2>%a@ %s@ %a@]" o#dot_expr x n o#dot_expr + y + | Ast.ExApp (_, x, y) -> + let (a, al) = get_expr_args x [ y ] + in + if + (not curry_constr) && + (Ast.is_expr_constructor a) + then + (match al with + | [ Ast.ExTup (_, _) ] -> + pp f "@[<2>%a@ (%a)@]" o#dot_expr x + o#expr y + | [ _ ] -> + pp f "@[<2>%a@ %a@]" o#dot_expr x + o#dot_expr y + | al -> + pp f "@[<2>%a@ (%a)@]" o#dot_expr a + (list o#under_pipe#expr ",@ ") al) + else + pp f "@[<2>%a@]" (list o#dot_expr "@ ") + (a :: al) + | Ast.ExAss (_, + (Ast.ExAcc (_, e1, + (Ast.ExId (_, (Ast.IdLid (_, "val")))))), + e2) -> pp f "@[<2>%a :=@ %a@]" o#expr e1 o#expr e2 + | Ast.ExAss (_, e1, e2) -> + pp f "@[<2>%a@ <-@ %a@]" o#expr e1 o#expr e2 + | Ast.ExFun (loc, (Ast.McNil _)) -> + pp f "@[<2>fun@ _@ ->@ %a@]" o#raise_match_failure + loc + | Ast.ExFun (_, (Ast.McArr (_, p, (Ast.ExNil _), e))) + when is_irrefut_patt p -> + pp f "@[<2>fun@ %a@]" o#patt_expr_fun_args (p, e) + | Ast.ExFun (_, a) -> + pp f "@[<hv0>function%a@]" o#match_case a + | Ast.ExIfe (_, e1, e2, e3) -> + pp f + "@[<hv0>@[<2>if@ %a@]@ @[<2>then@ %a@]@ @[<2>else@ %a@]@]" + o#expr e1 o#under_semi#expr e2 o#under_semi#expr + e3 + | Ast.ExLaz (_, e) -> pp f "@[<2>lazy@ %a@]" o#expr e + | Ast.ExLet (_, r, bi, e) -> + (match e with + | Ast.ExLet (_, _, _, _) -> + pp f "@[<0>@[<2>let %a%a in@]@ %a@]" + o#rec_flag r o#binding bi o#reset_semi#expr + e + | _ -> + pp f + "@[<hv0>@[<2>let %a%a@]@ @[<hv2>in@ %a@]@]" + o#rec_flag r o#binding bi o#reset_semi#expr + e) + | Ast.ExMat (_, e, a) -> + pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]" + o#expr e o#match_case a + | Ast.ExTry (_, e, a) -> + pp f "@[<0>@[<hv2>try@ %a@]@ @[<0>with%a@]@]" + o#expr e o#match_case a + | Ast.ExAsf _ -> pp f "@[<2>assert@ false@]" + | Ast.ExAsr (_, e) -> pp f "@[<2>assert@ %a@]" o#expr e + | Ast.ExLmd (_, s, me, e) -> + pp f "@[<2>let module %a =@ %a@]@ @[<2>in@ %a@]" + o#var s o#module_expr me o#expr e + | e -> o#dot_expr f e + method dot_expr = + fun f e -> + let () = o#node f e Ast.loc_of_expr + in + match e with + | Ast.ExAcc (_, e, + (Ast.ExId (_, (Ast.IdLid (_, "val"))))) -> + pp f "@[<2>!@,%a@]" o#simple_expr e + | Ast.ExAcc (_, e1, e2) -> + pp f "@[<2>%a.@,%a@]" o#dot_expr e1 o#dot_expr e2 + | Ast.ExAre (_, e1, e2) -> + pp f "@[<2>%a.@,(%a)@]" o#dot_expr e1 o#expr e2 + | Ast.ExSte (_, e1, e2) -> + pp f "%a.@[<1>[@,%a@]@,]" o#dot_expr e1 o#expr e2 + | Ast.ExSnd (_, e, s) -> + pp f "@[<2>%a#@,%s@]" o#dot_expr e s + | e -> o#simple_expr f e + method simple_expr = + fun f e -> + let () = o#node f e Ast.loc_of_expr + in + match e with + | Ast.ExNil _ -> () + | Ast.ExSeq (_, e) -> pp f "@[<hv1>(%a)@]" o#seq e + | Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExId (_, (Ast.IdUid (_, "::")))), _)), + _) -> o#expr_list_cons true f e + | Ast.ExTup (_, e) -> pp f "@[<1>(%a)@]" o#expr e + | Ast.ExArr (_, e) -> + pp f "@[<0>@[<2>[|@ %a@]@ |]@]" o#under_semi#expr e + | Ast.ExCoe (_, e, (Ast.TyNil _), t) -> + pp f "@[<2>(%a :>@ %a)@]" o#expr e o#ctyp t + | Ast.ExCoe (_, e, t1, t2) -> + pp f "@[<2>(%a :@ %a :>@ %a)@]" o#expr e o#ctyp t1 + o#ctyp t2 + | Ast.ExTyc (_, e, t) -> + pp f "@[<2>(%a :@ %a)@]" o#expr e o#ctyp t + | Ast.ExAnt (_, s) -> o#anti f s + | Ast.ExFor (_, s, e1, e2, df, e3) -> + pp f + "@[<hv0>@[<hv2>@[<2>for %a =@ %a@ %a@ %a@ do@]@ %a@]@ done@]" + o#var s o#expr e1 o#direction_flag df o#expr e2 + o#seq e3 + | Ast.ExInt (_, s) -> pp f "%a" o#intlike s + | Ast.ExNativeInt (_, s) -> pp f "%an" o#intlike s + | Ast.ExInt64 (_, s) -> pp f "%aL" o#intlike s + | Ast.ExInt32 (_, s) -> pp f "%al" o#intlike s + | Ast.ExFlo (_, s) -> pp f "%s" s + | Ast.ExChr (_, s) -> pp f "'%s'" (ocaml_char s) + | Ast.ExId (_, i) -> o#var_ident f i + | Ast.ExRec (_, b, (Ast.ExNil _)) -> + pp f "@[<hv0>@[<hv2>{@ %a@]@ }@]" o#record_binding + b + | Ast.ExRec (_, b, e) -> + pp f "@[<hv0>@[<hv2>{@ (%a)@ with@ %a@]@ }@]" + o#expr e o#record_binding b + | Ast.ExStr (_, s) -> pp f "\"%s\"" s + | Ast.ExWhi (_, e1, e2) -> + pp f "@[<2>while@ %a@ do@ %a@ done@]" o#expr e1 + o#seq e2 + | Ast.ExLab (_, s, (Ast.ExNil _)) -> pp f "~%s" s + | Ast.ExLab (_, s, e) -> + pp f "@[<2>~%s:@ %a@]" s o#dot_expr e + | Ast.ExOlb (_, s, (Ast.ExNil _)) -> pp f "?%s" s + | Ast.ExOlb (_, s, e) -> + pp f "@[<2>?%s:@ %a@]" s o#dot_expr e + | Ast.ExVrn (_, s) -> pp f "`%a" o#var s + | Ast.ExOvr (_, b) -> + pp f "@[<hv0>@[<hv2>{<@ %a@]@ >}@]" + o#record_binding b + | Ast.ExObj (_, (Ast.PaNil _), cst) -> + pp f "@[<hv0>@[<hv2>object@ %a@]@ end@]" + o#class_str_item cst + | Ast.ExObj (_, (Ast.PaTyc (_, p, t)), cst) -> + pp f + "@[<hv0>@[<hv2>object @[<1>(%a :@ %a)@]@ %a@]@ end@]" + o#patt p o#ctyp t o#class_str_item cst + | Ast.ExObj (_, p, cst) -> + pp f + "@[<hv0>@[<hv2>object @[<2>(%a)@]@ %a@]@ end@]" + o#patt p o#class_str_item cst + | Ast.ExNew (_, i) -> pp f "@[<2>new@ %a@]" o#ident i + | Ast.ExCom (_, e1, e2) -> + pp f "%a,@ %a" o#simple_expr e1 o#simple_expr e2 + | Ast.ExSem (_, e1, e2) -> + pp f "%a;@ %a" o#under_semi#expr e1 o#expr e2 + | Ast.ExApp (_, _, _) | Ast.ExAcc (_, _, _) | + Ast.ExAre (_, _, _) | Ast.ExSte (_, _, _) | + Ast.ExAss (_, _, _) | Ast.ExSnd (_, _, _) | + Ast.ExFun (_, _) | Ast.ExMat (_, _, _) | + Ast.ExTry (_, _, _) | Ast.ExIfe (_, _, _, _) | + Ast.ExLet (_, _, _, _) | Ast.ExLmd (_, _, _, _) | + Ast.ExAsr (_, _) | Ast.ExAsf _ | Ast.ExLaz (_, _) + -> pp f "(%a)" o#reset#expr e + method direction_flag = + fun f b -> + match b with + | Ast.BTrue -> pp_print_string f "to" + | Ast.BFalse -> pp_print_string f "downto" + | Ast.BAnt s -> o#anti f s + method patt = + fun f p -> + let () = o#node f p Ast.loc_of_patt + in + match p with + | Ast.PaAli (_, p1, p2) -> + pp f "@[<1>(%a@ as@ %a)@]" o#patt p1 o#patt p2 + | Ast.PaEq (_, p1, p2) -> + pp f "@[<2>%a =@ %a@]" o#patt p1 o#patt p2 + | Ast.PaSem (_, p1, p2) -> + pp f "%a;@ %a" o#patt p1 o#patt p2 + | p -> o#patt1 f p + method patt1 = + fun f -> + function + | Ast.PaOrp (_, p1, p2) -> + pp f "@[<2>%a@ |@ %a@]" o#patt1 p1 o#patt2 p2 + | p -> o#patt2 f p + method patt2 = fun f p -> o#patt3 f p + method patt3 = + fun f -> + function + | Ast.PaRng (_, p1, p2) -> + pp f "@[<2>%a@ ..@ %a@]" o#patt3 p1 o#patt4 p2 + | Ast.PaCom (_, p1, p2) -> + pp f "%a,@ %a" o#patt3 p1 o#patt3 p2 + | p -> o#patt4 f p + method patt4 = + fun f -> + function + | (Ast.PaApp (_, + (Ast.PaApp (_, + (Ast.PaId (_, (Ast.IdUid (_, "::")))), _)), + _) + as p) -> + let (pl, c) = o#mk_patt_list p + in + (match c with + | None -> + pp f "@[<2>[@ %a@]@ ]" (list o#patt ";@ ") pl + | Some x -> + pp f "@[<2>%a@]" (list o#patt5 " ::@ ") + (pl @ [ x ])) + | p -> o#patt5 f p + method patt5 = + fun f -> + function + | (Ast.PaApp (_, + (Ast.PaApp (_, + (Ast.PaId (_, (Ast.IdUid (_, "::")))), _)), + _) + as p) -> o#simple_patt f p + | Ast.PaApp (_, x, y) -> + let (a, al) = get_patt_args x [ y ] + in + if + (not curry_constr) && (Ast.is_patt_constructor a) + then + (match al with + | [ Ast.PaTup (_, _) ] -> + pp f "@[<2>%a@ (%a)@]" o#simple_patt x + o#patt y + | [ _ ] -> + pp f "@[<2>%a@ %a@]" o#patt5 x o#simple_patt + y + | al -> + pp f "@[<2>%a@ (%a)@]" o#patt5 a + (list o#simple_patt ",@ ") al) + else + pp f "@[<2>%a@]" (list o#simple_patt "@ ") + (a :: al) + | p -> o#simple_patt f p + method simple_patt = + fun f p -> + let () = o#node f p Ast.loc_of_patt + in + match p with + | Ast.PaNil _ -> () + | Ast.PaId (_, i) -> o#var_ident f i + | Ast.PaAnt (_, s) -> o#anti f s + | Ast.PaAny _ -> pp f "_" + | Ast.PaTup (_, p) -> pp f "@[<1>(%a)@]" o#patt3 p + | Ast.PaRec (_, p) -> pp f "@[<hv2>{@ %a@]@ }" o#patt p + | Ast.PaStr (_, s) -> pp f "\"%s\"" s + | Ast.PaTyc (_, p, t) -> + pp f "@[<1>(%a :@ %a)@]" o#patt p o#ctyp t + | Ast.PaNativeInt (_, s) -> pp f "%an" o#intlike s + | Ast.PaInt64 (_, s) -> pp f "%aL" o#intlike s + | Ast.PaInt32 (_, s) -> pp f "%al" o#intlike s + | Ast.PaInt (_, s) -> pp f "%a" o#intlike s + | Ast.PaFlo (_, s) -> pp f "%s" s + | Ast.PaChr (_, s) -> pp f "'%s'" (ocaml_char s) + | Ast.PaLab (_, s, (Ast.PaNil _)) -> pp f "~%s" s + | Ast.PaVrn (_, s) -> pp f "`%a" o#var s + | Ast.PaTyp (_, i) -> pp f "@[<2>#%a@]" o#ident i + | Ast.PaArr (_, p) -> pp f "@[<2>[|@ %a@]@ |]" o#patt p + | Ast.PaLab (_, s, p) -> + pp f "@[<2>~%s:@ (%a)@]" s o#patt p + | Ast.PaOlb (_, s, (Ast.PaNil _)) -> pp f "?%s" s + | Ast.PaOlb (_, "", p) -> pp f "@[<2>?(%a)@]" o#patt p + | Ast.PaOlb (_, s, p) -> + pp f "@[<2>?%s:@,@[<1>(%a)@]@]" s o#patt p + | Ast.PaOlbi (_, "", p, e) -> + pp f "@[<2>?(%a =@ %a)@]" o#patt p o#expr e + | Ast.PaOlbi (_, s, p, e) -> + pp f "@[<2>?%s:@,@[<1>(%a =@ %a)@]@]" s o#patt p + o#expr e + | (Ast.PaApp (_, _, _) | Ast.PaAli (_, _, _) | + Ast.PaOrp (_, _, _) | Ast.PaRng (_, _, _) | + Ast.PaCom (_, _, _) | Ast.PaSem (_, _, _) | + Ast.PaEq (_, _, _) + as p) -> pp f "@[<1>(%a)@]" o#patt p + method simple_ctyp = + fun f t -> + let () = o#node f t Ast.loc_of_ctyp + in + match t with + | Ast.TyId (_, i) -> o#ident f i + | Ast.TyAnt (_, s) -> o#anti f s + | Ast.TyAny _ -> pp f "_" + | Ast.TyLab (_, s, t) -> + pp f "@[<2>%s:@ %a@]" s o#simple_ctyp t + | Ast.TyOlb (_, s, t) -> + pp f "@[<2>?%s:@ %a@]" s o#simple_ctyp t + | Ast.TyObj (_, (Ast.TyNil _), Ast.BFalse) -> + pp f "< >" + | Ast.TyObj (_, (Ast.TyNil _), Ast.BTrue) -> + pp f "< .. >" + | Ast.TyObj (_, t, Ast.BTrue) -> + pp f "@[<0>@[<2><@ %a@ ..@]@ >@]" o#ctyp t + | Ast.TyObj (_, t, Ast.BFalse) -> + pp f "@[<0>@[<2><@ %a@]@ >@]" o#ctyp t + | Ast.TyQuo (_, s) -> pp f "'%a" o#var s + | Ast.TyRec (_, t) -> pp f "@[<2>{@ %a@]@ }" o#ctyp t + | Ast.TySum (_, t) -> pp f "@[<0>%a@]" o#sum_type t + | Ast.TyTup (_, t) -> pp f "@[<1>(%a)@]" o#ctyp t + | Ast.TyVrnEq (_, t) -> pp f "@[<2>[@ %a@]@ ]" o#ctyp t + | Ast.TyVrnInf (_, t) -> + pp f "@[<2>[<@ %a@]@,]" o#ctyp t + | Ast.TyVrnInfSup (_, t1, t2) -> + pp f "@[<2>[<@ %a@ >@ %a@]@ ]" o#ctyp t1 o#ctyp t2 + | Ast.TyVrnSup (_, t) -> + pp f "@[<2>[>@ %a@]@,]" o#ctyp t + | Ast.TyCls (_, i) -> pp f "@[<2>#%a@]" o#ident i + | Ast.TyMan (_, t1, t2) -> + pp f "@[<2>%a =@ %a@]" o#simple_ctyp t1 + o#simple_ctyp t2 + | Ast.TyVrn (_, s) -> pp f "`%a" o#var s + | Ast.TySta (_, t1, t2) -> + pp f "%a *@ %a" o#simple_ctyp t1 o#simple_ctyp t2 + | t -> pp f "@[<1>(%a)@]" o#ctyp t + method ctyp = + fun f t -> + let () = o#node f t Ast.loc_of_ctyp + in + match t with + | Ast.TyAli (_, t1, t2) -> + pp f "@[<2>%a@ as@ %a@]" o#simple_ctyp t1 + o#simple_ctyp t2 + | Ast.TyArr (_, t1, t2) -> + pp f "@[<2>%a@ ->@ %a@]" o#ctyp1 t1 o#ctyp t2 + | Ast.TyQuP (_, s) -> pp f "+'%a" o#var s + | Ast.TyQuM (_, s) -> pp f "-'%a" o#var s + | Ast.TyOr (_, t1, t2) -> + pp f "%a@ | %a" o#ctyp t1 o#ctyp t2 + | Ast.TyCol (_, t1, (Ast.TyMut (_, t2))) -> + pp f "@[mutable@ %a :@ %a@]" o#ctyp t1 o#ctyp t2 + | Ast.TyCol (_, t1, t2) -> + pp f "@[<2>%a :@ %a@]" o#ctyp t1 o#ctyp t2 + | Ast.TySem (_, t1, t2) -> + pp f "%a;@ %a" o#ctyp t1 o#ctyp t2 + | Ast.TyOf (_, t, (Ast.TyNil _)) -> o#ctyp f t + | Ast.TyOf (_, t1, t2) -> + pp f "@[<h>%a@ @[<3>of@ %a@]@]" o#ctyp t1 + o#constructor_type t2 + | Ast.TyOfAmp (_, t1, t2) -> + pp f "@[<h>%a@ @[<3>of &@ %a@]@]" o#ctyp t1 + o#constructor_type t2 + | Ast.TyAnd (_, t1, t2) -> + pp f "%a@ and %a" o#ctyp t1 o#ctyp t2 + | Ast.TyMut (_, t) -> + pp f "@[<2>mutable@ %a@]" o#ctyp t + | Ast.TyAmp (_, t1, t2) -> + pp f "%a@ &@ %a" o#ctyp t1 o#ctyp t2 + | Ast.TyDcl (_, tn, tp, te, cl) -> + (pp f "@[<2>%a%a@]" o#type_params tp o#var tn; + (match te with + | Ast.TyQuo (_, s) when + not + (List.exists + (function + | Ast.TyQuo (_, s') -> s = s' + | _ -> false) + tp) + -> () + | _ -> pp f " =@ %a" o#ctyp te); + if cl <> [] + then pp f "@ %a" (list o#constrain "@ ") cl + else ()) + | t -> o#ctyp1 f t + method ctyp1 = + fun f -> + function + | Ast.TyApp (_, t1, t2) -> + (match get_ctyp_args t1 [ t2 ] with + | (_, [ _ ]) -> + pp f "@[<2>%a@ %a@]" o#simple_ctyp t2 + o#simple_ctyp t1 + | (a, al) -> + pp f "@[<2>(%a)@ %a@]" (list o#ctyp ",@ ") al + o#simple_ctyp a) + | Ast.TyPol (_, t1, t2) -> + let (a, al) = get_ctyp_args t1 [] + in + pp f "@[<2>%a.@ %a@]" (list o#ctyp "@ ") (a :: al) + o#ctyp t2 + | Ast.TyPrv (_, t) -> + pp f "@[private@ %a@]" o#simple_ctyp t + | t -> o#simple_ctyp f t + method constructor_type = + fun f t -> + match t with + | Ast.TyAnd (loc, t1, t2) -> + let () = o#node f t (fun _ -> loc) + in + pp f "%a@ * %a" o#constructor_type t1 + o#constructor_type t2 + | Ast.TyArr (_, _, _) -> pp f "(%a)" o#ctyp t + | t -> o#ctyp f t + method sig_item = + fun f sg -> + let () = o#node f sg Ast.loc_of_sig_item + in + match sg with + | Ast.SgNil _ -> () + | Ast.SgSem (_, sg, (Ast.SgNil _)) | + Ast.SgSem (_, (Ast.SgNil _), sg) -> o#sig_item f sg + | Ast.SgSem (_, sg1, sg2) -> + (o#sig_item f sg1; cut f; o#sig_item f sg2) + | Ast.SgExc (_, t) -> + pp f "@[<2>exception@ %a%s@]" o#ctyp t semisep + | Ast.SgExt (_, s1, t, s2) -> + pp f "@[<2>external@ %a :@ %a =@ %a%s@]" o#var s1 + o#ctyp t o#quoted_string s2 semisep + | Ast.SgMod (_, s1, (Ast.MtFun (_, s2, mt1, mt2))) -> + let rec loop accu = + (function + | Ast.MtFun (_, s, mt1, mt2) -> + loop ((s, mt1) :: accu) mt2 + | mt -> ((List.rev accu), mt)) in + let (al, mt) = loop [ (s2, mt1) ] mt2 + in + pp f "@[<2>module %a@ @[<0>%a@] :@ %a%s@]" + o#var s1 o#functor_args al o#module_type mt + semisep + | Ast.SgMod (_, s, mt) -> + pp f "@[<2>module %a :@ %a%s@]" o#var s + o#module_type mt semisep + | Ast.SgMty (_, s, mt) -> + pp f "@[<2>module type %a =@ %a%s@]" o#var s + o#module_type mt semisep + | Ast.SgOpn (_, sl) -> + pp f "@[<2>open@ %a%s@]" o#ident sl semisep + | Ast.SgTyp (_, t) -> + pp f "@[<hv0>@[<hv2>type %a@]%s@]" o#ctyp t semisep + | Ast.SgVal (_, s, t) -> + pp f "@[<2>%s %a :@ %a%s@]" value_val o#var s + o#ctyp t semisep + | Ast.SgInc (_, mt) -> + pp f "@[<2>include@ %a%s@]" o#module_type mt + semisep + | Ast.SgClt (_, ct) -> + pp f "@[<2>class type %a%s@]" o#class_type ct + semisep + | Ast.SgCls (_, ce) -> + pp f "@[<2>class %a%s@]" o#class_type ce semisep + | Ast.SgRecMod (_, mb) -> + pp f "@[<2>module rec %a%s@]" o#module_rec_binding + mb semisep + | Ast.SgDir (_, _, _) -> () + | Ast.SgAnt (_, s) -> pp f "%a%s" o#anti s semisep + method str_item = + fun f st -> + let () = o#node f st Ast.loc_of_str_item + in + match st with + | Ast.StNil _ -> () + | Ast.StSem (_, st, (Ast.StNil _)) | + Ast.StSem (_, (Ast.StNil _), st) -> o#str_item f st + | Ast.StSem (_, st1, st2) -> + (o#str_item f st1; cut f; o#str_item f st2) + | Ast.StExc (_, t, Ast.ONone) -> + pp f "@[<2>exception@ %a%s@]" o#ctyp t semisep + | Ast.StExc (_, t, (Ast.OSome sl)) -> + pp f "@[<2>exception@ %a =@ %a%s@]" o#ctyp t + o#ident sl semisep + | Ast.StExt (_, s1, t, s2) -> + pp f "@[<2>external@ %a :@ %a =@ %a%s@]" o#var s1 + o#ctyp t o#quoted_string s2 semisep + | Ast.StMod (_, s1, (Ast.MeFun (_, s2, mt1, me))) -> + (match o#module_expr_get_functor_args [ (s2, mt1) ] + me + with + | (al, me, Some mt2) -> + pp f + "@[<2>module %a@ @[<0>%a@] :@ %a =@ %a%s@]" + o#var s1 o#functor_args al o#module_type mt2 + o#module_expr me semisep + | (al, me, _) -> + pp f "@[<2>module %a@ @[<0>%a@] =@ %a%s@]" + o#var s1 o#functor_args al o#module_expr me + semisep) + | Ast.StMod (_, s, (Ast.MeTyc (_, me, mt))) -> + pp f "@[<2>module %a :@ %a =@ %a%s@]" o#var s + o#module_type mt o#module_expr me semisep + | Ast.StMod (_, s, me) -> + pp f "@[<2>module %a =@ %a%s@]" o#var s + o#module_expr me semisep + | Ast.StMty (_, s, mt) -> + pp f "@[<2>module type %a =@ %a%s@]" o#var s + o#module_type mt semisep + | Ast.StOpn (_, sl) -> + pp f "@[<2>open@ %a%s@]" o#ident sl semisep + | Ast.StTyp (_, t) -> + pp f "@[<hv0>@[<hv2>type %a@]%s@]" o#ctyp t semisep + | Ast.StVal (_, r, bi) -> + pp f "@[<2>%s %a%a%s@]" value_let o#rec_flag r + o#binding bi semisep + | Ast.StExp (_, e) -> + pp f "@[<2>let _ =@ %a%s@]" o#expr e semisep + | Ast.StInc (_, me) -> + pp f "@[<2>include@ %a%s@]" o#module_expr me + semisep + | Ast.StClt (_, ct) -> + pp f "@[<2>class type %a%s@]" o#class_type ct + semisep + | Ast.StCls (_, ce) -> + pp f "@[<hv2>class %a%s@]" o#class_declaration ce + semisep + | Ast.StRecMod (_, mb) -> + pp f "@[<2>module rec %a%s@]" o#module_rec_binding + mb semisep + | Ast.StDir (_, _, _) -> () + | Ast.StAnt (_, s) -> pp f "%a%s" o#anti s semisep + | Ast.StExc (_, _, (Ast.OAnt _)) -> assert false + method module_type = + fun f mt -> + let () = o#node f mt Ast.loc_of_module_type + in + match mt with + | Ast.MtId (_, i) -> o#ident f i + | Ast.MtAnt (_, s) -> o#anti f s + | Ast.MtFun (_, s, mt1, mt2) -> + pp f "@[<2>functor@ @[<1>(%a :@ %a)@]@ ->@ %a@]" + o#var s o#module_type mt1 o#module_type mt2 + | Ast.MtQuo (_, s) -> pp f "'%a" o#var s + | Ast.MtSig (_, sg) -> + pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" o#sig_item sg + | Ast.MtWit (_, mt, wc) -> + pp f "@[<2>%a@ with@ %a@]" o#module_type mt + o#with_constraint wc + method with_constraint = + fun f wc -> + let () = o#node f wc Ast.loc_of_with_constr + in + match wc with + | Ast.WcNil _ -> () + | Ast.WcTyp (_, t1, t2) -> + pp f "@[<2>type@ %a =@ %a@]" o#ctyp t1 o#ctyp t2 + | Ast.WcMod (_, i1, i2) -> + pp f "@[<2>module@ %a =@ %a@]" o#ident i1 o#ident + i2 + | Ast.WcAnd (_, wc1, wc2) -> + (o#with_constraint f wc1; + pp f andsep; + o#with_constraint f wc2) + | Ast.WcAnt (_, s) -> o#anti f s + method module_expr = + fun f me -> + let () = o#node f me Ast.loc_of_module_expr + in + match me with + | Ast.MeId (_, i) -> o#ident f i + | Ast.MeAnt (_, s) -> o#anti f s + | Ast.MeApp (_, me1, me2) -> + pp f "@[<2>%a@,(%a)@]" o#module_expr me1 + o#module_expr me2 + | Ast.MeFun (_, s, mt, me) -> + pp f "@[<2>functor@ @[<1>(%a :@ %a)@]@ ->@ %a@]" + o#var s o#module_type mt o#module_expr me + | Ast.MeStr (_, st) -> + pp f "@[<hv0>@[<hv2>struct@ %a@]@ end@]" o#str_item + st + | Ast.MeTyc (_, (Ast.MeStr (_, st)), + (Ast.MtSig (_, sg))) -> + pp f + "@[<2>@[<hv2>struct@ %a@]@ end :@ @[<hv2>sig@ %a@]@ end@]" + o#str_item st o#sig_item sg + | Ast.MeTyc (_, me, mt) -> + pp f "@[<1>(%a :@ %a)@]" o#module_expr me + o#module_type mt + method class_expr = + fun f ce -> + let () = o#node f ce Ast.loc_of_class_expr + in + match ce with + | Ast.CeApp (_, ce, e) -> + pp f "@[<2>%a@ %a@]" o#class_expr ce o#expr e + | Ast.CeCon (_, Ast.BFalse, i, (Ast.TyNil _)) -> + pp f "@[<2>%a@]" o#ident i + | Ast.CeCon (_, Ast.BFalse, i, t) -> + pp f "@[<2>@[<1>[%a]@]@ %a@]" o#class_params t + o#ident i + | Ast.CeCon (_, Ast.BTrue, i, (Ast.TyNil _)) -> + pp f "@[<2>virtual@ %a@]" o#ident i + | Ast.CeCon (_, Ast.BTrue, i, t) -> + pp f "@[<2>virtual@ @[<1>[%a]@]@ %a@]" + o#class_params t o#ident i + | Ast.CeFun (_, p, ce) -> + pp f "@[<2>fun@ %a@ ->@ %a@]" o#patt p o#class_expr + ce + | Ast.CeLet (_, r, bi, ce) -> + pp f "@[<2>let %a%a@]@ @[<2>in@ %a@]" o#rec_flag r + o#binding bi o#class_expr ce + | Ast.CeStr (_, (Ast.PaNil _), cst) -> + pp f "@[<hv0>@[<hv2>object %a@]@ end@]" + o#class_str_item cst + | Ast.CeStr (_, p, cst) -> + pp f + "@[<hv0>@[<hv2>object @[<1>(%a)@]@ %a@]@ end@]" + o#patt p o#class_str_item cst + | Ast.CeTyc (_, ce, ct) -> + pp f "@[<1>(%a :@ %a)@]" o#class_expr ce + o#class_type ct + | Ast.CeAnt (_, s) -> o#anti f s + | Ast.CeAnd (_, ce1, ce2) -> + (o#class_expr f ce1; + pp f andsep; + o#class_expr f ce2) + | Ast.CeEq (_, ce1, (Ast.CeFun (_, p, ce2))) when + is_irrefut_patt p -> + pp f "@[<2>%a@ %a" o#class_expr ce1 + o#patt_class_expr_fun_args (p, ce2) + | Ast.CeEq (_, ce1, ce2) -> + pp f "@[<2>%a =@]@ %a" o#class_expr ce1 + o#class_expr ce2 + | _ -> assert false + method class_type = + fun f ct -> + let () = o#node f ct Ast.loc_of_class_type + in + match ct with + | Ast.CtCon (_, Ast.BFalse, i, (Ast.TyNil _)) -> + pp f "@[<2>%a@]" o#ident i + | Ast.CtCon (_, Ast.BFalse, i, t) -> + pp f "@[<2>[@,%a@]@,]@ %a" o#class_params t + o#ident i + | Ast.CtCon (_, Ast.BTrue, i, (Ast.TyNil _)) -> + pp f "@[<2>virtual@ %a@]" o#ident i + | Ast.CtCon (_, Ast.BTrue, i, t) -> + pp f "@[<2>virtual@ [@,%a@]@,]@ %a" o#class_params + t o#ident i + | Ast.CtFun (_, t, ct) -> + pp f "@[<2>%a@ ->@ %a@]" o#simple_ctyp t + o#class_type ct + | Ast.CtSig (_, (Ast.TyNil _), csg) -> + pp f "@[<hv0>@[<hv2>object@ %a@]@ end@]" + o#class_sig_item csg + | Ast.CtSig (_, t, csg) -> + pp f + "@[<hv0>@[<hv2>object @[<1>(%a)@]@ %a@]@ end@]" + o#ctyp t o#class_sig_item csg + | Ast.CtAnt (_, s) -> o#anti f s + | Ast.CtAnd (_, ct1, ct2) -> + (o#class_type f ct1; + pp f andsep; + o#class_type f ct2) + | Ast.CtCol (_, ct1, ct2) -> + pp f "%a :@ %a" o#class_type ct1 o#class_type ct2 + | Ast.CtEq (_, ct1, ct2) -> + pp f "%a =@ %a" o#class_type ct1 o#class_type ct2 + | _ -> assert false + method class_sig_item = + fun f csg -> + let () = o#node f csg Ast.loc_of_class_sig_item + in + match csg with + | Ast.CgNil _ -> () + | Ast.CgSem (_, csg, (Ast.CgNil _)) | + Ast.CgSem (_, (Ast.CgNil _), csg) -> + o#class_sig_item f csg + | Ast.CgSem (_, csg1, csg2) -> + (o#class_sig_item f csg1; + cut f; + o#class_sig_item f csg2) + | Ast.CgCtr (_, t1, t2) -> + pp f "@[<2>type@ %a =@ %a%s@]" o#ctyp t1 o#ctyp t2 + semisep + | Ast.CgInh (_, ct) -> + pp f "@[<2>inherit@ %a%s@]" o#class_type ct semisep + | Ast.CgMth (_, s, pr, t) -> + pp f "@[<2>method %a%a :@ %a%s@]" o#private_flag pr + o#var s o#ctyp t semisep + | Ast.CgVir (_, s, pr, t) -> + pp f "@[<2>method virtual %a%a :@ %a%s@]" + o#private_flag pr o#var s o#ctyp t semisep + | Ast.CgVal (_, s, mu, vi, t) -> + pp f "@[<2>%s %a%a%a :@ %a%s@]" value_val + o#mutable_flag mu o#virtual_flag vi o#var s + o#ctyp t semisep + | Ast.CgAnt (_, s) -> pp f "%a%s" o#anti s semisep + method class_str_item = + fun f cst -> + let () = o#node f cst Ast.loc_of_class_str_item + in + match cst with + | Ast.CrNil _ -> () + | Ast.CrSem (_, cst, (Ast.CrNil _)) | + Ast.CrSem (_, (Ast.CrNil _), cst) -> + o#class_str_item f cst + | Ast.CrSem (_, cst1, cst2) -> + (o#class_str_item f cst1; + cut f; + o#class_str_item f cst2) + | Ast.CrCtr (_, t1, t2) -> + pp f "@[<2>type %a =@ %a%s@]" o#ctyp t1 o#ctyp t2 + semisep + | Ast.CrInh (_, ce, "") -> + pp f "@[<2>inherit@ %a%s@]" o#class_expr ce semisep + | Ast.CrInh (_, ce, s) -> + pp f "@[<2>inherit@ %a as@ %a%s@]" o#class_expr ce + o#var s semisep + | Ast.CrIni (_, e) -> + pp f "@[<2>initializer@ %a%s@]" o#expr e semisep + | Ast.CrMth (_, s, pr, e, (Ast.TyNil _)) -> + pp f "@[<2>method %a%a =@ %a%s@]" o#private_flag pr + o#var s o#expr e semisep + | Ast.CrMth (_, s, pr, e, t) -> + pp f "@[<2>method %a%a :@ %a =@ %a%s@]" + o#private_flag pr o#var s o#ctyp t o#expr e + semisep + | Ast.CrVir (_, s, pr, t) -> + pp f "@[<2>method virtual@ %a%a :@ %a%s@]" + o#private_flag pr o#var s o#ctyp t semisep + | Ast.CrVvr (_, s, mu, t) -> + pp f "@[<2>%s virtual %a%a :@ %a%s@]" value_val + o#mutable_flag mu o#var s o#ctyp t semisep + | Ast.CrVal (_, s, mu, e) -> + pp f "@[<2>%s %a%a =@ %a%s@]" value_val + o#mutable_flag mu o#var s o#expr e semisep + | Ast.CrAnt (_, s) -> pp f "%a%s" o#anti s semisep + method implem = + fun f st -> + match st with + | Ast.StExp (_, e) -> + pp f "@[<0>%a%s@]@." o#expr e semisep + | st -> pp f "@[<v0>%a@]@." o#str_item st + method interf = fun f sg -> pp f "@[<v0>%a@]@." o#sig_item sg + end + let with_outfile output_file fct arg = + let call close f = + ((try fct f arg with | exn -> (close (); raise exn)); + close ()) + in + match output_file with + | None -> call (fun () -> ()) std_formatter + | Some s -> + let oc = open_out s in + let f = formatter_of_out_channel oc + in call (fun () -> close_out oc) f + let print output_file fct = + let o = new printer () in with_outfile output_file (fct o) + let print_interf ?input_file:(_) ?output_file sg = + print output_file (fun o -> o#interf) sg + let print_implem ?input_file:(_) ?output_file st = + print output_file (fun o -> o#implem) st + end + module MakeMore (Syntax : Sig.Camlp4Syntax) : + Sig.Printer with module Ast = Syntax.Ast = + struct + include Make(Syntax) + let semisep = ref false + let margin = ref 78 + let comments = ref true + let locations = ref false + let curry_constr = ref false + let print output_file fct = + let o = + new printer ~comments: !comments ~curry_constr: !curry_constr + () in + let o = + if !semisep then o#set_semisep ";;" else o#set_semisep "" in + let o = if !locations then o#set_loc_and_comments else o + in + with_outfile output_file + (fun f -> + let () = Format.pp_set_margin f !margin + in Format.fprintf f "@[<v0>%a@]@." (fct o)) + let print_interf ?input_file:(_) ?output_file sg = + print output_file (fun o -> o#interf) sg + let print_implem ?input_file:(_) ?output_file st = + print output_file (fun o -> o#implem) st + let _ = + Options.add "-l" (Arg.Int (fun i -> margin := i)) + "<length> line length for pretty printing." + let _ = + Options.add "-ss" (Arg.Set semisep) "Print double semicolons." + let _ = + Options.add "-curry-constr" (Arg.Set curry_constr) + "Use currified constructors." + let _ = + Options.add "-no_ss" (Arg.Clear semisep) + "Do not print double semicolons (default)." + let _ = + Options.add "-no_comments" (Arg.Clear comments) + "Do not add comments." + let _ = + Options.add "-add_locations" (Arg.Set locations) + "Add locations as comment." + end + end + module OCamlr : + sig + module Id : Sig.Id + module Make (Syntax : Sig.Camlp4Syntax) : + sig + open Format + include Sig.Camlp4Syntax with module Loc = Syntax.Loc + and module Warning = Syntax.Warning + and module Token = Syntax.Token and module Ast = Syntax.Ast + and module Gram = Syntax.Gram + class printer : + ?curry_constr: bool -> + ?comments: bool -> + unit -> object ('a) inherit OCaml.Make(Syntax).printer end + val with_outfile : + string option -> (formatter -> 'a -> unit) -> 'a -> unit + val print : + string option -> + (printer -> formatter -> 'a -> unit) -> 'a -> unit + val print_interf : + ?input_file: string -> + ?output_file: string -> Ast.sig_item -> unit + val print_implem : + ?input_file: string -> + ?output_file: string -> Ast.str_item -> unit + end + module MakeMore (Syntax : Sig.Camlp4Syntax) : + Sig.Printer with module Ast = Syntax.Ast + end = + struct + open Format + module Id = + struct + let name = "Camlp4.Printers.OCamlr" + let version = + "$Id: OCamlr.ml,v 1.16 2006/10/10 22:32:43 ertai Exp $" + end + module Make (Syntax : Sig.Camlp4Syntax) = + struct + include Syntax + open Sig + module PP_o = OCaml.Make(Syntax) + open PP_o + let pp = fprintf + class printer ?curry_constr:(init_curry_constr = true) + ?(comments = true) () = + object (o) + inherit + PP_o.printer ~curry_constr: init_curry_constr ~comments () as + super + val semisep = ";" + val andsep = + ("@]@ @[<2>and@ " : (unit, formatter, unit) format) + val value_val = "value" + val value_let = "value" + val mode = if comments then `comments else `no_comments + val curry_constr = init_curry_constr + val first_match_case = true + method under_pipe = o + method under_semi = o + method reset_semi = o + method reset = o + method private unset_first_match_case = + {< first_match_case = false; >} + method private set_first_match_case = + {< first_match_case = true; >} + method seq = + fun f e -> + let rec self right f e = + let go_right = self right + and go_left = self false + in + match e with + | Ast.ExLet (_, r, bi, e1) -> + if right + then + pp f "@[<2>let %a%a@];@ %a" o#rec_flag r + o#binding bi go_right e1 + else pp f "(%a)" o#expr e + | Ast.ExSeq (_, e) -> go_right f e + | Ast.ExSem (_, e1, e2) -> + (pp f "%a;@ " go_left e1; + (match (right, e2) with + | (true, Ast.ExLet (_, r, bi, e3)) -> + pp f "@[<2>let %a%a@];@ %a" o#rec_flag r + o#binding bi go_right e3 + | _ -> go_right f e2)) + | e -> o#expr f e + in self true f e + method var = + fun f -> + function + | "" -> pp f "$lid:\"\"$" + | "[]" -> pp f "[]" + | "()" -> pp f "()" + | " True" -> pp f "True" + | " False" -> pp f "False" + | v -> + (match lex_string v with + | LIDENT s | UIDENT s | ESCAPED_IDENT s when + is_keyword s -> pp f "\\%s" s + | SYMBOL s -> pp f "\\%s" s + | LIDENT s | UIDENT s | ESCAPED_IDENT s -> + pp_print_string f s + | tok -> + failwith + (sprintf "Bad token used as an identifier: %s" + (Token.to_string tok))) + method type_params = + fun f -> + function + | [] -> () + | [ x ] -> pp f "@ %a" o#ctyp x + | l -> pp f "@ @[<1>%a@]" (list o#ctyp "@ ") l + method match_case = + fun f -> + function + | Ast.McNil _ -> pp f "@ []" + | m -> + pp f "@ [ %a ]" o#set_first_match_case#match_case_aux + m + method match_case_aux = + fun f -> + function + | Ast.McNil _ -> () + | Ast.McAnt (_, s) -> o#anti f s + | Ast.McOr (_, a1, a2) -> + pp f "%a%a" o#match_case_aux a1 + o#unset_first_match_case#match_case_aux a2 + | Ast.McArr (_, p, (Ast.ExNil _), e) -> + let () = if first_match_case then () else pp f "@ | " + in + pp f "@[<2>%a@ ->@ %a@]" o#patt p o#under_pipe#expr + e + | Ast.McArr (_, p, w, e) -> + let () = if first_match_case then () else pp f "@ | " + in + pp f "@[<2>%a@ when@ %a@ ->@ %a@]" o#patt p + o#under_pipe#expr w o#under_pipe#expr e + method sum_type = fun f t -> pp f "@[<hv0>[ %a ]@]" o#ctyp t + method ident = + fun f i -> + let () = o#node f i Ast.loc_of_ident + in + match i with + | Ast.IdApp (_, i1, i2) -> + pp f "%a@ %a" o#dot_ident i1 o#dot_ident i2 + | i -> o#dot_ident f i + method private dot_ident = + fun f i -> + let () = o#node f i Ast.loc_of_ident + in + match i with + | Ast.IdAcc (_, i1, i2) -> + pp f "%a.@,%a" o#dot_ident i1 o#dot_ident i2 + | Ast.IdAnt (_, s) -> o#anti f s + | Ast.IdLid (_, s) | Ast.IdUid (_, s) -> o#var f s + | i -> pp f "(%a)" o#ident i + method patt4 = + fun f -> + function + | (Ast.PaApp (_, + (Ast.PaApp (_, + (Ast.PaId (_, (Ast.IdUid (_, "::")))), _)), + _) + as p) -> + let (pl, c) = o#mk_patt_list p + in + (match c with + | None -> + pp f "@[<2>[@ %a@]@ ]" (list o#patt ";@ ") pl + | Some x -> + pp f "@[<2>[ %a ::@ %a ]@]" + (list o#patt ";@ ") pl o#patt x) + | p -> super#patt4 f p + method expr_list_cons = + fun _ f e -> + let (el, c) = o#mk_expr_list e + in + match c with + | None -> o#expr_list f el + | Some x -> + pp f "@[<2>[ %a ::@ %a ]@]" (list o#expr ";@ ") el + o#expr x + method expr = + fun f e -> + let () = o#node f e Ast.loc_of_expr + in + match e with + | Ast.ExAss (_, e1, e2) -> + pp f "@[<2>%a@ :=@ %a@]" o#expr e1 o#expr e2 + | Ast.ExFun (_, (Ast.McArr (_, p, (Ast.ExNil _), e))) + when Ast.is_irrefut_patt p -> + pp f "@[<2>fun@ %a@]" o#patt_expr_fun_args (p, e) + | Ast.ExFun (_, a) -> + pp f "@[<hv0>fun%a@]" o#match_case a + | Ast.ExAsf _ -> pp f "@[<2>assert@ False@]" + | e -> super#expr f e + method dot_expr = + fun f e -> + let () = o#node f e Ast.loc_of_expr + in + match e with + | Ast.ExAcc (_, e, + (Ast.ExId (_, (Ast.IdLid (_, "val"))))) -> + pp f "@[<2>%a.@,val@]" o#simple_expr e + | e -> super#dot_expr f e + method simple_expr = + fun f e -> + let () = o#node f e Ast.loc_of_expr + in + match e with + | Ast.ExFor (_, s, e1, e2, Ast.BTrue, e3) -> + pp f + "@[<hv0>@[<hv2>@[<2>for %a@ =@ %a@ to@ %a@ do {@]@ %a@]@ }@]" + o#var s o#expr e1 o#expr e2 o#seq e3 + | Ast.ExFor (_, s, e1, e2, Ast.BFalse, e3) -> + pp f + "@[<hv0>@[<hv2>@[<2>for %a@ =@ %a@ downto@ %a@ do {@]@ %a@]@ }@]" + o#var s o#expr e1 o#expr e2 o#seq e3 + | Ast.ExWhi (_, e1, e2) -> + pp f "@[<2>while@ %a@ do {@ %a@ }@]" o#expr e1 + o#seq e2 + | Ast.ExSeq (_, e) -> + pp f "@[<hv0>@[<hv2>do {@ %a@]@ }@]" o#seq e + | e -> super#simple_expr f e + method ctyp = + fun f t -> + let () = o#node f t Ast.loc_of_ctyp + in + match t with + | Ast.TyDcl (_, tn, tp, te, cl) -> + (pp f "@[<2>%a%a@]" o#var tn o#type_params tp; + (match te with + | Ast.TyQuo (_, s) when + not + (List.exists + (function + | Ast.TyQuo (_, s') -> s = s' + | _ -> false) + tp) + -> () + | _ -> pp f " =@ %a" o#ctyp te); + if cl <> [] + then pp f "@ %a" (list o#constrain "@ ") cl + else ()) + | Ast.TyCol (_, t1, (Ast.TyMut (_, t2))) -> + pp f "@[%a :@ mutable %a@]" o#ctyp t1 o#ctyp t2 + | t -> super#ctyp f t + method simple_ctyp = + fun f t -> + let () = o#node f t Ast.loc_of_ctyp + in + match t with + | Ast.TyVrnEq (_, t) -> + pp f "@[<2>[ =@ %a@]@ ]" o#ctyp t + | Ast.TyVrnInf (_, t) -> + pp f "@[<2>[ <@ %a@]@,]" o#ctyp t + | Ast.TyVrnInfSup (_, t1, t2) -> + pp f "@[<2>[ <@ %a@ >@ %a@]@ ]" o#ctyp t1 o#ctyp t2 + | Ast.TyVrnSup (_, t) -> + pp f "@[<2>[ >@ %a@]@,]" o#ctyp t + | Ast.TyMan (_, t1, t2) -> + pp f "@[<2>%a@ ==@ %a@]" o#simple_ctyp t1 + o#simple_ctyp t2 + | Ast.TyLab (_, s, t) -> + pp f "@[<2>~%s:@ %a@]" s o#simple_ctyp t + | t -> super#simple_ctyp f t + method ctyp1 = + fun f -> + function + | Ast.TyApp (_, t1, t2) -> + (match get_ctyp_args t1 [ t2 ] with + | (_, [ _ ]) -> + pp f "@[<2>%a@ %a@]" o#simple_ctyp t1 + o#simple_ctyp t2 + | (a, al) -> + pp f "@[<2>%a@]" (list o#simple_ctyp "@ ") + (a :: al)) + | Ast.TyPol (_, t1, t2) -> + let (a, al) = get_ctyp_args t1 [] + in + pp f "@[<2>! %a.@ %a@]" (list o#ctyp "@ ") + (a :: al) o#ctyp t2 + | t -> super#ctyp1 f t + method constructor_type = + fun f t -> + match t with + | Ast.TyAnd (loc, t1, t2) -> + let () = o#node f t (fun _ -> loc) + in + pp f "%a@ and %a" o#constructor_type t1 + o#constructor_type t2 + | t -> o#ctyp f t + method str_item = + fun f st -> + match st with + | Ast.StExp (_, e) -> pp f "@[<2>%a%s@]" o#expr e semisep + | st -> super#str_item f st + method module_expr = + fun f me -> + let () = o#node f me Ast.loc_of_module_expr + in + match me with + | Ast.MeApp (_, me1, me2) -> + pp f "@[<2>%a@,(%a)@]" o#module_expr me1 + o#module_expr me2 + | me -> super#module_expr f me + method implem = fun f st -> pp f "@[<v0>%a@]@." o#str_item st + method class_type = + fun f ct -> + let () = o#node f ct Ast.loc_of_class_type + in + match ct with + | Ast.CtFun (_, t, ct) -> + pp f "@[<2>[ %a ] ->@ %a@]" o#simple_ctyp t + o#class_type ct + | Ast.CtCon (_, Ast.BFalse, i, (Ast.TyNil _)) -> + pp f "@[<2>%a@]" o#ident i + | Ast.CtCon (_, Ast.BFalse, i, t) -> + pp f "@[<2>%a [@,%a@]@,]" o#ident i o#class_params + t + | Ast.CtCon (_, Ast.BTrue, i, (Ast.TyNil _)) -> + pp f "@[<2>virtual@ %a@]" o#ident i + | Ast.CtCon (_, Ast.BTrue, i, t) -> + pp f "@[<2>virtual@ %a@ [@,%a@]@,]" o#ident i + o#class_params t + | ct -> super#class_type f ct + method class_expr = + fun f ce -> + let () = o#node f ce Ast.loc_of_class_expr + in + match ce with + | Ast.CeCon (_, Ast.BFalse, i, (Ast.TyNil _)) -> + pp f "@[<2>%a@]" o#ident i + | Ast.CeCon (_, Ast.BFalse, i, t) -> + pp f "@[<2>%a@ @[<1>[%a]@]@]" o#ident i + o#class_params t + | Ast.CeCon (_, Ast.BTrue, i, (Ast.TyNil _)) -> + pp f "@[<2>virtual@ %a@]" o#ident i + | Ast.CeCon (_, Ast.BTrue, i, t) -> + pp f "@[<2>virtual@ %a@ @[<1>[%a]@]@]" o#ident i + o#ctyp t + | ce -> super#class_expr f ce + end + let with_outfile = with_outfile + let print = print + let print_interf = print_interf + let print_implem = print_implem + end + module MakeMore (Syntax : Sig.Camlp4Syntax) : + Sig.Printer with module Ast = Syntax.Ast = + struct + include Make(Syntax) + let margin = ref 78 + let comments = ref true + let locations = ref false + let curry_constr = ref true + let print output_file fct = + let o = + new printer ~comments: !comments ~curry_constr: !curry_constr + () in + let o = if !locations then o#set_loc_and_comments else o + in + with_outfile output_file + (fun f -> + let () = Format.pp_set_margin f !margin + in Format.fprintf f "@[<v0>%a@]@." (fct o)) + let print_interf ?input_file:(_) ?output_file sg = + print output_file (fun o -> o#interf) sg + let print_implem ?input_file:(_) ?output_file st = + print output_file (fun o -> o#implem) st + let _ = + Options.add "-l" (Arg.Int (fun i -> margin := i)) + "<length> line length for pretty printing." + let _ = + Options.add "-no_comments" (Arg.Clear comments) + "Do not add comments." + let _ = + Options.add "-add_locations" (Arg.Set locations) + "Add locations as comment." + end + end + end +module OCamlInitSyntax = + struct + module Make + (Warning : Sig.Warning) + (Ast : Sig.Camlp4Ast with module Loc = Warning.Loc) + (Gram : + Sig.Grammar.Static with module Loc = Warning.Loc with + type Token.t = Sig.camlp4_token) + (Quotation : Sig.Quotation with module Ast = Sig.Camlp4AstToAst(Ast)) : + Sig.Camlp4Syntax with module Loc = Ast.Loc and module Ast = Ast + and module Token = Gram.Token and module Gram = Gram + and module AntiquotSyntax.Ast = Sig.Camlp4AstToAst(Ast) + and module Quotation = Quotation = + struct + module Warning = Warning + module Loc = Ast.Loc + module Ast = Ast + module Gram = Gram + module Token = Gram.Token + open Sig + let a_CHAR = Gram.Entry.mk "a_CHAR" + let a_FLOAT = Gram.Entry.mk "a_FLOAT" + let a_INT = Gram.Entry.mk "a_INT" + let a_INT32 = Gram.Entry.mk "a_INT32" + let a_INT64 = Gram.Entry.mk "a_INT64" + let a_LABEL = Gram.Entry.mk "a_LABEL" + let a_LIDENT = Gram.Entry.mk "a_LIDENT" + let a_LIDENT_or_operator = Gram.Entry.mk "a_LIDENT_or_operator" + let a_NATIVEINT = Gram.Entry.mk "a_NATIVEINT" + let a_OPTLABEL = Gram.Entry.mk "a_OPTLABEL" + let a_STRING = Gram.Entry.mk "a_STRING" + let a_UIDENT = Gram.Entry.mk "a_UIDENT" + let a_ident = Gram.Entry.mk "a_ident" + let amp_ctyp = Gram.Entry.mk "amp_ctyp" + let and_ctyp = Gram.Entry.mk "and_ctyp" + let match_case = Gram.Entry.mk "match_case" + let match_case0 = Gram.Entry.mk "match_case0" + let binding = Gram.Entry.mk "binding" + let class_declaration = Gram.Entry.mk "class_declaration" + let class_description = Gram.Entry.mk "class_description" + let class_expr = Gram.Entry.mk "class_expr" + let class_fun_binding = Gram.Entry.mk "class_fun_binding" + let class_fun_def = Gram.Entry.mk "class_fun_def" + let class_info_for_class_expr = + Gram.Entry.mk "class_info_for_class_expr" + let class_info_for_class_type = + Gram.Entry.mk "class_info_for_class_type" + let class_longident = Gram.Entry.mk "class_longident" + let class_longident_and_param = + Gram.Entry.mk "class_longident_and_param" + let class_name_and_param = Gram.Entry.mk "class_name_and_param" + let class_sig_item = Gram.Entry.mk "class_sig_item" + let class_signature = Gram.Entry.mk "class_signature" + let class_str_item = Gram.Entry.mk "class_str_item" + let class_structure = Gram.Entry.mk "class_structure" + let class_type = Gram.Entry.mk "class_type" + let class_type_declaration = Gram.Entry.mk "class_type_declaration" + let class_type_longident = Gram.Entry.mk "class_type_longident" + let class_type_longident_and_param = + Gram.Entry.mk "class_type_longident_and_param" + let class_type_plus = Gram.Entry.mk "class_type_plus" + let comma_ctyp = Gram.Entry.mk "comma_ctyp" + let comma_expr = Gram.Entry.mk "comma_expr" + let comma_ipatt = Gram.Entry.mk "comma_ipatt" + let comma_patt = Gram.Entry.mk "comma_patt" + let comma_type_parameter = Gram.Entry.mk "comma_type_parameter" + let constrain = Gram.Entry.mk "constrain" + let constructor_arg_list = Gram.Entry.mk "constructor_arg_list" + let constructor_declaration = Gram.Entry.mk "constructor_declaration" + let constructor_declarations = + Gram.Entry.mk "constructor_declarations" + let ctyp = Gram.Entry.mk "ctyp" + let cvalue_binding = Gram.Entry.mk "cvalue_binding" + let direction_flag = Gram.Entry.mk "direction_flag" + let dummy = Gram.Entry.mk "dummy" + let entry_eoi = Gram.Entry.mk "entry_eoi" + let eq_expr = Gram.Entry.mk "eq_expr" + let expr = Gram.Entry.mk "expr" + let expr_eoi = Gram.Entry.mk "expr_eoi" + let field = Gram.Entry.mk "field" + let field_expr = Gram.Entry.mk "field_expr" + let fun_binding = Gram.Entry.mk "fun_binding" + let fun_def = Gram.Entry.mk "fun_def" + let ident = Gram.Entry.mk "ident" + let implem = Gram.Entry.mk "implem" + let interf = Gram.Entry.mk "interf" + let ipatt = Gram.Entry.mk "ipatt" + let ipatt_tcon = Gram.Entry.mk "ipatt_tcon" + let label = Gram.Entry.mk "label" + let label_declaration = Gram.Entry.mk "label_declaration" + let label_expr = Gram.Entry.mk "label_expr" + let label_ipatt = Gram.Entry.mk "label_ipatt" + let label_longident = Gram.Entry.mk "label_longident" + let label_patt = Gram.Entry.mk "label_patt" + let labeled_ipatt = Gram.Entry.mk "labeled_ipatt" + let let_binding = Gram.Entry.mk "let_binding" + let meth_list = Gram.Entry.mk "meth_list" + let module_binding = Gram.Entry.mk "module_binding" + let module_binding0 = Gram.Entry.mk "module_binding0" + let module_declaration = Gram.Entry.mk "module_declaration" + let module_expr = Gram.Entry.mk "module_expr" + let module_longident = Gram.Entry.mk "module_longident" + let module_longident_with_app = + Gram.Entry.mk "module_longident_with_app" + let module_rec_declaration = Gram.Entry.mk "module_rec_declaration" + let module_type = Gram.Entry.mk "module_type" + let more_ctyp = Gram.Entry.mk "more_ctyp" + let name_tags = Gram.Entry.mk "name_tags" + let opt_as_lident = Gram.Entry.mk "opt_as_lident" + let opt_class_self_patt = Gram.Entry.mk "opt_class_self_patt" + let opt_class_self_type = Gram.Entry.mk "opt_class_self_type" + let opt_class_signature = Gram.Entry.mk "opt_class_signature" + let opt_class_structure = Gram.Entry.mk "opt_class_structure" + let opt_comma_ctyp = Gram.Entry.mk "opt_comma_ctyp" + let opt_dot_dot = Gram.Entry.mk "opt_dot_dot" + let opt_eq_ctyp = Gram.Entry.mk "opt_eq_ctyp" + let opt_expr = Gram.Entry.mk "opt_expr" + let opt_meth_list = Gram.Entry.mk "opt_meth_list" + let opt_mutable = Gram.Entry.mk "opt_mutable" + let opt_polyt = Gram.Entry.mk "opt_polyt" + let opt_private = Gram.Entry.mk "opt_private" + let opt_rec = Gram.Entry.mk "opt_rec" + let opt_sig_items = Gram.Entry.mk "opt_sig_items" + let opt_str_items = Gram.Entry.mk "opt_str_items" + let opt_virtual = Gram.Entry.mk "opt_virtual" + let opt_when_expr = Gram.Entry.mk "opt_when_expr" + let patt = Gram.Entry.mk "patt" + let patt_as_patt_opt = Gram.Entry.mk "patt_as_patt_opt" + let patt_eoi = Gram.Entry.mk "patt_eoi" + let patt_tcon = Gram.Entry.mk "patt_tcon" + let phrase = Gram.Entry.mk "phrase" + let pipe_ctyp = Gram.Entry.mk "pipe_ctyp" + let poly_type = Gram.Entry.mk "poly_type" + let row_field = Gram.Entry.mk "row_field" + let sem_ctyp = Gram.Entry.mk "sem_ctyp" + let sem_expr = Gram.Entry.mk "sem_expr" + let sem_expr_for_list = Gram.Entry.mk "sem_expr_for_list" + let sem_patt = Gram.Entry.mk "sem_patt" + let sem_patt_for_list = Gram.Entry.mk "sem_patt_for_list" + let semi = Gram.Entry.mk "semi" + let sequence = Gram.Entry.mk "sequence" + let sig_item = Gram.Entry.mk "sig_item" + let sig_items = Gram.Entry.mk "sig_items" + let star_ctyp = Gram.Entry.mk "star_ctyp" + let str_item = Gram.Entry.mk "str_item" + let str_items = Gram.Entry.mk "str_items" + let top_phrase = Gram.Entry.mk "top_phrase" + let type_constraint = Gram.Entry.mk "type_constraint" + let type_declaration = Gram.Entry.mk "type_declaration" + let type_ident_and_parameters = + Gram.Entry.mk "type_ident_and_parameters" + let type_kind = Gram.Entry.mk "type_kind" + let type_longident = Gram.Entry.mk "type_longident" + let type_longident_and_parameters = + Gram.Entry.mk "type_longident_and_parameters" + let type_parameter = Gram.Entry.mk "type_parameter" + let type_parameters = Gram.Entry.mk "type_parameters" + let typevars = Gram.Entry.mk "typevars" + let use_file = Gram.Entry.mk "use_file" + let val_longident = Gram.Entry.mk "val_longident" + let value_let = Gram.Entry.mk "value_let" + let value_val = Gram.Entry.mk "value_val" + let with_constr = Gram.Entry.mk "with_constr" + let expr_quot = Gram.Entry.mk "quotation of expression" + let patt_quot = Gram.Entry.mk "quotation of pattern" + let ctyp_quot = Gram.Entry.mk "quotation of type" + let str_item_quot = Gram.Entry.mk "quotation of structure item" + let sig_item_quot = Gram.Entry.mk "quotation of signature item" + let class_str_item_quot = + Gram.Entry.mk "quotation of class structure item" + let class_sig_item_quot = + Gram.Entry.mk "quotation of class signature item" + let module_expr_quot = Gram.Entry.mk "quotation of module expression" + let module_type_quot = Gram.Entry.mk "quotation of module type" + let class_type_quot = Gram.Entry.mk "quotation of class type" + let class_expr_quot = Gram.Entry.mk "quotation of class expression" + let with_constr_quot = Gram.Entry.mk "quotation of with constraint" + let binding_quot = Gram.Entry.mk "quotation of binding" + let match_case_quot = + Gram.Entry.mk "quotation of match_case (try/match/function case)" + let module_binding_quot = + Gram.Entry.mk "quotation of module rec binding" + let ident_quot = Gram.Entry.mk "quotation of identifier" + let _ = + Gram.extend (top_phrase : 'top_phrase Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | EOI -> (None : 'top_phrase) + | _ -> assert false))) ]) ])) + ()) + module AntiquotSyntax = + struct + module Loc = Ast.Loc + module Ast = Sig.Camlp4AstToAst(Ast) + module Gram = Gram + let antiquot_expr = Gram.Entry.mk "antiquot_expr" + let antiquot_patt = Gram.Entry.mk "antiquot_patt" + let _ = + (Gram.extend (antiquot_expr : 'antiquot_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Stoken + (((function | EOI -> true | _ -> false), + "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (x : 'expr) + (_loc : Loc.t) -> + match __camlp4_0 with + | EOI -> (x : 'antiquot_expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (antiquot_patt : 'antiquot_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Stoken + (((function | EOI -> true | _ -> false), + "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (x : 'patt) + (_loc : Loc.t) -> + match __camlp4_0 with + | EOI -> (x : 'antiquot_patt) + | _ -> assert false))) ]) ])) + ())) + let parse_expr loc str = Gram.parse_string antiquot_expr loc str + let parse_patt loc str = Gram.parse_string antiquot_patt loc str + end + module Quotation = Quotation + module Parser = + struct + module Ast = Ast + let wrap directive_handler pa init_loc cs = + let rec loop loc = + let (pl, stopped_at_directive) = pa loc cs + in + match stopped_at_directive with + | Some new_loc -> + let pl = + (match List.rev pl with + | [] -> assert false + | x :: xs -> + (match directive_handler x with + | None -> xs + | Some x -> x :: xs)) + in (List.rev pl) @ (loop new_loc) + | None -> pl + in loop init_loc + let parse_implem ?(directive_handler = fun _ -> None) _loc cs = + let l = wrap directive_handler (Gram.parse implem) _loc cs + in Ast.stSem_of_list l + let parse_interf ?(directive_handler = fun _ -> None) _loc cs = + let l = wrap directive_handler (Gram.parse interf) _loc cs + in Ast.sgSem_of_list l + end + module Printer = Struct.EmptyPrinter.Make(Ast) + end + end +module PreCast : + sig + type camlp4_token = + Sig.camlp4_token = + | KEYWORD of string | SYMBOL of string | LIDENT of string + | UIDENT of string | ESCAPED_IDENT of string | INT of int * string + | INT32 of int32 * string | INT64 of int64 * string + | NATIVEINT of nativeint * string | FLOAT of float * string + | CHAR of char * string | STRING of string * string | LABEL of string + | OPTLABEL of string | QUOTATION of Sig.quotation + | ANTIQUOT of string * string | COMMENT of string | BLANKS of string + | NEWLINE | LINE_DIRECTIVE of int * string option | EOI + module Id : Sig.Id + module Loc : Sig.Loc + module Warning : Sig.Warning with module Loc = Loc + module Ast : Sig.Camlp4Ast with module Loc = Loc + module Token : Sig.Token with module Loc = Loc and type t = camlp4_token + module Lexer : Sig.Lexer with module Loc = Loc and module Token = Token + module Gram : Sig.Grammar.Static with module Loc = Loc + and module Token = Token + module Quotation : + Sig.Quotation with module Ast = Sig.Camlp4AstToAst(Ast) + module DynLoader : Sig.DynLoader + module AstFilters : Sig.AstFilters with module Ast = Ast + module Syntax : Sig.Camlp4Syntax with module Loc = Loc + and module Warning = Warning and module Token = Token + and module Ast = Ast and module Gram = Gram + and module Quotation = Quotation + module Printers : + sig + module OCaml : Sig.Printer with module Ast = Sig.Camlp4AstToAst(Ast) + module OCamlr : Sig.Printer with module Ast = Sig.Camlp4AstToAst(Ast) + module DumpOCamlAst : + Sig.Printer with module Ast = Sig.Camlp4AstToAst(Ast) + module DumpCamlp4Ast : + Sig.Printer with module Ast = Sig.Camlp4AstToAst(Ast) + module Null : Sig.Printer with module Ast = Sig.Camlp4AstToAst(Ast) + end + module MakeGram (Lexer : Sig.Lexer with module Loc = Loc) : + Sig.Grammar.Static with module Loc = Loc and module Token = Lexer.Token + end = + struct + module Id = + struct + let name = "Camlp4.PreCast" + let version = "$Id: PreCast.ml,v 1.3 2006/10/02 12:59:00 ertai Exp $" + end + type camlp4_token = + Sig.camlp4_token = + | KEYWORD of string | SYMBOL of string | LIDENT of string + | UIDENT of string | ESCAPED_IDENT of string | INT of int * string + | INT32 of int32 * string | INT64 of int64 * string + | NATIVEINT of nativeint * string | FLOAT of float * string + | CHAR of char * string | STRING of string * string | LABEL of string + | OPTLABEL of string | QUOTATION of Sig.quotation + | ANTIQUOT of string * string | COMMENT of string | BLANKS of string + | NEWLINE | LINE_DIRECTIVE of int * string option | EOI + module Loc = Struct.Loc + module Warning = Struct.Warning.Make(Loc) + module Ast = Struct.Camlp4Ast.Make(Loc) + module Token = Struct.Token.Make(Loc) + module Lexer = Struct.Lexer.Make(Token) + module Gram = Struct.Grammar.Static.Make(Lexer) + module DynLoader = Struct.DynLoader + module Quotation = Struct.Quotation.Make(Ast) + module Syntax = OCamlInitSyntax.Make(Warning)(Ast)(Gram)(Quotation) + module AstFilters = Struct.AstFilters.Make(Ast) + module MakeGram = Struct.Grammar.Static.Make + module Printers = + struct + module OCaml = Printers.OCaml.Make(Syntax) + module OCamlr = Printers.OCamlr.Make(Syntax) + module DumpOCamlAst = Printers.DumpOCamlAst.Make(Syntax) + module DumpCamlp4Ast = Printers.DumpCamlp4Ast.Make(Syntax) + module Null = Printers.Null.Make(Syntax) + end + end +module Register : + sig + module Plugin + (Id : Sig.Id) (Plugin : functor (Unit : sig end) -> sig end) : + sig end + module SyntaxPlugin + (Id : Sig.Id) (SyntaxPlugin : functor (Syn : Sig.Syntax) -> sig end) : + sig end + module SyntaxExtension + (Id : Sig.Id) (SyntaxExtension : Sig.SyntaxExtension) : sig end + module OCamlSyntaxExtension + (Id : Sig.Id) + (SyntaxExtension : + functor (Syntax : Sig.Camlp4Syntax) -> Sig.Camlp4Syntax) : + sig end + type 'a parser_fun = + ?directive_handler: ('a -> 'a option) -> + PreCast.Loc.t -> char Stream.t -> 'a + val register_str_item_parser : PreCast.Ast.str_item parser_fun -> unit + val register_sig_item_parser : PreCast.Ast.sig_item parser_fun -> unit + val register_parser : + PreCast.Ast.str_item parser_fun -> + PreCast.Ast.sig_item parser_fun -> unit + module Parser + (Id : Sig.Id) + (Maker : functor (Ast : Sig.Ast) -> Sig.Parser with module Ast = Ast) : + sig end + module OCamlParser + (Id : Sig.Id) + (Maker : + functor (Ast : Sig.Camlp4Ast) -> Sig.Parser with module Ast = Ast) : + sig end + module OCamlPreCastParser + (Id : Sig.Id) (Parser : Sig.Parser with module Ast = PreCast.Ast) : + sig end + type 'a printer_fun = + ?input_file: string -> ?output_file: string -> 'a -> unit + val register_str_item_printer : PreCast.Ast.str_item printer_fun -> unit + val register_sig_item_printer : PreCast.Ast.sig_item printer_fun -> unit + val register_printer : + PreCast.Ast.str_item printer_fun -> + PreCast.Ast.sig_item printer_fun -> unit + module Printer + (Id : Sig.Id) + (Maker : + functor (Syn : Sig.Syntax) -> Sig.Printer with module Ast = Syn.Ast) : + sig end + module OCamlPrinter + (Id : Sig.Id) + (Maker : + functor (Syn : Sig.Camlp4Syntax) -> + Sig.Printer with module Ast = Syn.Ast) : + sig end + module OCamlPreCastPrinter + (Id : Sig.Id) (Printer : Sig.Printer with module Ast = PreCast.Ast) : + sig end + module AstFilter + (Id : Sig.Id) (Maker : functor (F : Sig.AstFilters) -> sig end) : + sig end + val declare_dyn_module : string -> (unit -> unit) -> unit + val iter_and_take_callbacks : ((string * (unit -> unit)) -> unit) -> unit + module CurrentParser : Sig.Parser with module Ast = PreCast.Ast + module CurrentPrinter : Sig.Printer with module Ast = PreCast.Ast + val enable_ocaml_printer : unit -> unit + val enable_ocamlr_printer : unit -> unit + val enable_null_printer : unit -> unit + val enable_dump_ocaml_ast_printer : unit -> unit + val enable_dump_camlp4_ast_printer : unit -> unit + end = + struct + module PP = Printers + open PreCast + type 'a parser_fun = + ?directive_handler: ('a -> 'a option) -> + PreCast.Loc.t -> char Stream.t -> 'a + type 'a printer_fun = + ?input_file: string -> ?output_file: string -> 'a -> unit + let sig_item_parser = + ref (fun ?directive_handler:(_) _ _ -> failwith "No interface parser") + let str_item_parser = + ref + (fun ?directive_handler:(_) _ _ -> + failwith "No implementation parser") + let sig_item_printer = + ref + (fun ?input_file:(_) ?output_file:(_) _ -> + failwith "No interface printer") + let str_item_printer = + ref + (fun ?input_file:(_) ?output_file:(_) _ -> + failwith "No implementation printer") + let callbacks = Queue.create () + let iter_and_take_callbacks f = + let rec loop () = loop (f (Queue.take callbacks)) + in try loop () with | Queue.Empty -> () + let declare_dyn_module m f = Queue.add (m, f) callbacks + let register_str_item_parser f = str_item_parser := f + let register_sig_item_parser f = sig_item_parser := f + let register_parser f g = (str_item_parser := f; sig_item_parser := g) + let register_str_item_printer f = str_item_printer := f + let register_sig_item_printer f = sig_item_printer := f + let register_printer f g = (str_item_printer := f; sig_item_printer := g) + module Plugin + (Id : Sig.Id) (Maker : functor (Unit : sig end) -> sig end) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(struct end) in ()) + end + module SyntaxExtension (Id : Sig.Id) (Maker : Sig.SyntaxExtension) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(Syntax) in ()) + end + module OCamlSyntaxExtension + (Id : Sig.Id) + (Maker : functor (Syn : Sig.Camlp4Syntax) -> Sig.Camlp4Syntax) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(Syntax) in ()) + end + module SyntaxPlugin + (Id : Sig.Id) (Maker : functor (Syn : Sig.Syntax) -> sig end) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(Syntax) in ()) + end + module Printer + (Id : Sig.Id) + (Maker : + functor (Syn : Sig.Syntax) -> Sig.Printer with module Ast = Syn.Ast) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(Syntax) + in register_printer M.print_implem M.print_interf) + end + module OCamlPrinter + (Id : Sig.Id) + (Maker : + functor (Syn : Sig.Camlp4Syntax) -> + Sig.Printer with module Ast = Syn.Ast) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(Syntax) + in register_printer M.print_implem M.print_interf) + end + module OCamlPreCastPrinter + (Id : Sig.Id) (P : Sig.Printer with module Ast = PreCast.Ast) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> register_printer P.print_implem P.print_interf) + end + module Parser + (Id : Sig.Id) + (Maker : functor (Ast : Sig.Ast) -> Sig.Parser with module Ast = Ast) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(PreCast.Ast) + in register_parser M.parse_implem M.parse_interf) + end + module OCamlParser + (Id : Sig.Id) + (Maker : + functor (Ast : Sig.Camlp4Ast) -> Sig.Parser with module Ast = Ast) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(PreCast.Ast) + in register_parser M.parse_implem M.parse_interf) + end + module OCamlPreCastParser + (Id : Sig.Id) (P : Sig.Parser with module Ast = PreCast.Ast) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> register_parser P.parse_implem P.parse_interf) + end + module AstFilter + (Id : Sig.Id) (Maker : functor (F : Sig.AstFilters) -> sig end) = + struct + let _ = + declare_dyn_module Id.name + (fun _ -> let module M = Maker(AstFilters) in ()) + end + let _ = let module M = Syntax.Parser + in + (sig_item_parser := M.parse_interf; + str_item_parser := M.parse_implem) + module CurrentParser = + struct + module Ast = Ast + let parse_interf ?directive_handler loc strm = + !sig_item_parser ?directive_handler loc strm + let parse_implem ?directive_handler loc strm = + !str_item_parser ?directive_handler loc strm + end + module CurrentPrinter = + struct + module Ast = Ast + let print_interf ?input_file ?output_file ast = + !sig_item_printer ?input_file ?output_file ast + let print_implem ?input_file ?output_file ast = + !str_item_printer ?input_file ?output_file ast + end + let enable_ocaml_printer () = + let module M = OCamlPrinter(PP.OCaml.Id)(PP.OCaml.MakeMore) in () + let enable_ocamlr_printer () = + let module M = OCamlPrinter(PP.OCamlr.Id)(PP.OCamlr.MakeMore) in () + let enable_dump_ocaml_ast_printer () = + let module M = OCamlPrinter(PP.DumpOCamlAst.Id)(PP.DumpOCamlAst.Make) + in () + let enable_dump_camlp4_ast_printer () = + let module M = Printer(PP.DumpCamlp4Ast.Id)(PP.DumpCamlp4Ast.Make) + in () + let enable_null_printer () = + let module M = Printer(PP.Null.Id)(PP.Null.Make) in () + end + diff --git a/camlp4/boot/Camlp4.ml4 b/camlp4/boot/Camlp4.ml4 new file mode 100644 index 000000000..f1ebc5f70 --- /dev/null +++ b/camlp4/boot/Camlp4.ml4 @@ -0,0 +1,79 @@ +module Debug : sig INCLUDE "camlp4/Camlp4/Debug.mli"; end = struct INCLUDE "camlp4/Camlp4/Debug.ml"; end; +module Options : sig INCLUDE "camlp4/Camlp4/Options.mli"; end = struct INCLUDE "camlp4/Camlp4/Options.ml"; end; +module Sig = struct INCLUDE "camlp4/Camlp4/Sig.ml"; end; +module ErrorHandler : sig INCLUDE "camlp4/Camlp4/ErrorHandler.mli"; end = struct INCLUDE "camlp4/Camlp4/ErrorHandler.ml"; end; + +module Struct = struct + module Loc : + sig INCLUDE "camlp4/Camlp4/Struct/Loc.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/Loc.ml"; end; + module Warning = struct INCLUDE "camlp4/Camlp4/Struct/Warning.ml"; end; + module Token : + sig INCLUDE "camlp4/Camlp4/Struct/Token.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/Token.ml"; end; + module Lexer = struct INCLUDE "camlp4/boot/Lexer.ml"; end; + module Camlp4Ast = struct INCLUDE "camlp4/boot/Camlp4Ast.ml"; end; + module Quotation = struct INCLUDE "camlp4/Camlp4/Struct/Quotation.ml"; end; + module AstFilters = struct INCLUDE "camlp4/Camlp4/Struct/AstFilters.ml"; end; + module Camlp4Ast2OCamlAst : + sig INCLUDE "camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml"; end; + module CleanAst = struct INCLUDE "camlp4/Camlp4/Struct/CleanAst.ml"; end; + module CommentFilter : + sig INCLUDE "camlp4/Camlp4/Struct/CommentFilter.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/CommentFilter.ml"; end; + module DynLoader : + sig INCLUDE "camlp4/Camlp4/Struct/DynLoader.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/DynLoader.ml"; end; + module EmptyError : + sig INCLUDE "camlp4/Camlp4/Struct/EmptyError.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/EmptyError.ml"; end; + module EmptyPrinter : + sig INCLUDE "camlp4/Camlp4/Struct/EmptyPrinter.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/EmptyPrinter.ml"; end; + module FreeVars : + sig INCLUDE "camlp4/Camlp4/Struct/FreeVars.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/FreeVars.ml"; end; + module Grammar = struct + module Context = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Context.ml"; end; + module Structure = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Structure.ml"; end; + module Search = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Search.ml"; end; + (* module Find = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Find.ml"; end; *) + module Tools = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Tools.ml"; end; + module Print : + sig INCLUDE "camlp4/Camlp4/Struct/Grammar/Print.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Print.ml"; end; + module Failed = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Failed.ml"; end; + module Parser = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Parser.ml"; end; + module Insert = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Insert.ml"; end; + module Delete = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Delete.ml"; end; + module Fold : + sig INCLUDE "camlp4/Camlp4/Struct/Grammar/Fold.mli"; end = + struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Fold.ml"; end; + module Entry = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Entry.ml"; end; + module Static = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Static.ml"; end; + module Dynamic = struct INCLUDE "camlp4/Camlp4/Struct/Grammar/Dynamic.ml"; end; + end; +end; + +module Printers = struct + module DumpCamlp4Ast : + sig INCLUDE "camlp4/Camlp4/Printers/DumpCamlp4Ast.mli"; end = + struct INCLUDE "camlp4/Camlp4/Printers/DumpCamlp4Ast.ml"; end; + module DumpOCamlAst : + sig INCLUDE "camlp4/Camlp4/Printers/DumpOCamlAst.mli"; end = + struct INCLUDE "camlp4/Camlp4/Printers/DumpOCamlAst.ml"; end; + module Null : + sig INCLUDE "camlp4/Camlp4/Printers/Null.mli"; end = + struct INCLUDE "camlp4/Camlp4/Printers/Null.ml"; end; + module OCaml : + sig INCLUDE "camlp4/Camlp4/Printers/OCaml.mli"; end = + struct INCLUDE "camlp4/Camlp4/Printers/OCaml.ml"; end; + module OCamlr : + sig INCLUDE "camlp4/Camlp4/Printers/OCamlr.mli"; end = + struct INCLUDE "camlp4/Camlp4/Printers/OCamlr.ml"; end; +end; + +module OCamlInitSyntax = struct INCLUDE "camlp4/Camlp4/OCamlInitSyntax.ml"; end; +module PreCast : sig INCLUDE "camlp4/Camlp4/PreCast.mli"; end = struct INCLUDE "camlp4/Camlp4/PreCast.ml"; end; +module Register : sig INCLUDE "camlp4/Camlp4/Register.mli"; end = struct INCLUDE "camlp4/Camlp4/Register.ml"; end; diff --git a/camlp4/Camlp4/Struct/Camlp4Ast.ml b/camlp4/boot/Camlp4Ast.ml index b98a8a5f4..51629568e 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast.ml +++ b/camlp4/boot/Camlp4Ast.ml @@ -1,10 +1,26 @@ -(* Generated file! Do not edit by hand *) -module Make (Loc : Sig.Loc.S) : Sig.Camlp4Ast.S with module Loc = Loc = +(****************************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* INRIA Rocquencourt *) +(* *) +(* Copyright 2006 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed under *) +(* the terms of the GNU Library General Public License, with the special *) +(* exception on linking described in LICENSE at the top of the Objective *) +(* Caml source tree. *) +(* *) +(****************************************************************************) +(* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) +module Make (Loc : Sig.Loc) : Sig.Camlp4Ast with module Loc = Loc = struct module Loc = Loc; module Ast = struct - include Sig.Camlp4Ast.Make(Loc); + include Sig.MakeCamlp4Ast(Loc); value safe_string_escaped s = if ((String.length s) > 2) && ((s.[0] = '\\') && (s.[1] = '$')) then s @@ -31,7 +47,13 @@ module Make (Loc : Sig.Loc.S) : Sig.Camlp4Ast.S with module Loc = Loc = struct module type META_LOC = sig + (** The first location is where to put the returned pattern. + Generally it's _loc to match with <:patt< ... >> quotations. + The second location is the one to treat. *) value meta_loc_patt : Loc.t -> Loc.t -> Ast.patt; + (** The first location is where to put the returned expression. + Generally it's _loc to match with <:expr< ... >> quotations. + The second location is the one to treat. *) value meta_loc_expr : Loc.t -> Loc.t -> Ast.expr; end; module MetaLoc = @@ -4631,7 +4653,7 @@ module Make (Loc : Sig.Loc.S) : Sig.Camlp4Ast.S with module Loc = Loc = in fun [ Ast.ExId _ i -> i - | Ast.ExApp _loc e1 e2 -> error () + | Ast.ExApp _ _ _ -> error () | t -> self t ]; value ident_of_ctyp = let error () = @@ -4797,7 +4819,7 @@ module Make (Loc : Sig.Loc.S) : Sig.Camlp4Ast.S with module Loc = Loc = [ Ast.BiAnd _ b1 b2 -> (pel_of_binding b1) @ (pel_of_binding b2) | Ast.BiEq _ p e -> [ (p, e) ] | Ast.BiSem _ b1 b2 -> (pel_of_binding b1) @ (pel_of_binding b2) - | t -> assert False ]; + | _ -> assert False ]; value rec list_of_binding x acc = match x with [ Ast.BiAnd _ b1 b2 | Ast.BiSem _ b1 b2 -> diff --git a/camlp4/boot/camlp4boot b/camlp4/boot/camlp4boot Binary files differdeleted file mode 100755 index 84bfa2909..000000000 --- a/camlp4/boot/camlp4boot +++ /dev/null diff --git a/camlp4/boot/camlp4boot.ml b/camlp4/boot/camlp4boot.ml new file mode 100644 index 000000000..9bdb28fd5 --- /dev/null +++ b/camlp4/boot/camlp4boot.ml @@ -0,0 +1,12159 @@ +module R = + struct + open Camlp4 + (* -*- camlp4r -*- *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + module Id = + struct + let name = "Camlp4RevisedParserParser" + let version = + "$Id: OCamlr.ml,v 1.12 2006/07/17 14:18:26 pouillar Exp $" + end + module Make (Syntax : Sig.Camlp4Syntax) = + struct + open Sig + include Syntax + (* Camlp4_config.constructors_arity.val := True; *) + let _ = Camlp4_config.constructors_arity := false + let help_sequences () = + (Printf.eprintf + "\ +New syntax: + do {e1; e2; ... ; en} + while e do {e1; e2; ... ; en} + for v = v1 to/downto v2 do {e1; e2; ... ; en} +Old (no more supported) syntax: + do e1; e2; ... ; en-1; return en + while e do e1; e2; ... ; en; done + for v = v1 to/downto v2 do e1; e2; ... ; en; done + "; + flush stderr; + exit 1) + let _ = + Options.add "-help_seq" (Arg.Unit help_sequences) + "Print explanations about new sequences and exit." + let _ = Gram.Entry.clear a_CHAR + let _ = Gram.Entry.clear a_FLOAT + let _ = Gram.Entry.clear a_INT + let _ = Gram.Entry.clear a_INT32 + let _ = Gram.Entry.clear a_INT64 + let _ = Gram.Entry.clear a_LABEL + let _ = Gram.Entry.clear a_LIDENT + let _ = Gram.Entry.clear a_LIDENT_or_operator + let _ = Gram.Entry.clear a_NATIVEINT + let _ = Gram.Entry.clear a_OPTLABEL + let _ = Gram.Entry.clear a_STRING + let _ = Gram.Entry.clear a_UIDENT + let _ = Gram.Entry.clear a_ident + let _ = Gram.Entry.clear amp_ctyp + let _ = Gram.Entry.clear and_ctyp + let _ = Gram.Entry.clear match_case + let _ = Gram.Entry.clear match_case0 + let _ = Gram.Entry.clear match_case_quot + let _ = Gram.Entry.clear binding + let _ = Gram.Entry.clear binding_quot + let _ = Gram.Entry.clear class_declaration + let _ = Gram.Entry.clear class_description + let _ = Gram.Entry.clear class_expr + let _ = Gram.Entry.clear class_expr_quot + let _ = Gram.Entry.clear class_fun_binding + let _ = Gram.Entry.clear class_fun_def + let _ = Gram.Entry.clear class_info_for_class_expr + let _ = Gram.Entry.clear class_info_for_class_type + let _ = Gram.Entry.clear class_longident + let _ = Gram.Entry.clear class_longident_and_param + let _ = Gram.Entry.clear class_name_and_param + let _ = Gram.Entry.clear class_sig_item + let _ = Gram.Entry.clear class_sig_item_quot + let _ = Gram.Entry.clear class_signature + let _ = Gram.Entry.clear class_str_item + let _ = Gram.Entry.clear class_str_item_quot + let _ = Gram.Entry.clear class_structure + let _ = Gram.Entry.clear class_type + let _ = Gram.Entry.clear class_type_declaration + let _ = Gram.Entry.clear class_type_longident + let _ = Gram.Entry.clear class_type_longident_and_param + let _ = Gram.Entry.clear class_type_plus + let _ = Gram.Entry.clear class_type_quot + let _ = Gram.Entry.clear comma_ctyp + let _ = Gram.Entry.clear comma_expr + let _ = Gram.Entry.clear comma_ipatt + let _ = Gram.Entry.clear comma_patt + let _ = Gram.Entry.clear comma_type_parameter + let _ = Gram.Entry.clear constrain + let _ = Gram.Entry.clear constructor_arg_list + let _ = Gram.Entry.clear constructor_declaration + let _ = Gram.Entry.clear constructor_declarations + let _ = Gram.Entry.clear ctyp + let _ = Gram.Entry.clear ctyp_quot + let _ = Gram.Entry.clear cvalue_binding + let _ = Gram.Entry.clear direction_flag + let _ = Gram.Entry.clear dummy + let _ = Gram.Entry.clear eq_expr + let _ = Gram.Entry.clear expr + let _ = Gram.Entry.clear expr_eoi + let _ = Gram.Entry.clear expr_quot + let _ = Gram.Entry.clear field + let _ = Gram.Entry.clear field_expr + let _ = Gram.Entry.clear fun_binding + let _ = Gram.Entry.clear fun_def + let _ = Gram.Entry.clear ident + let _ = Gram.Entry.clear ident_quot + let _ = Gram.Entry.clear implem + let _ = Gram.Entry.clear interf + let _ = Gram.Entry.clear ipatt + let _ = Gram.Entry.clear ipatt_tcon + let _ = Gram.Entry.clear label + let _ = Gram.Entry.clear label_declaration + let _ = Gram.Entry.clear label_expr + let _ = Gram.Entry.clear label_ipatt + let _ = Gram.Entry.clear label_longident + let _ = Gram.Entry.clear label_patt + let _ = Gram.Entry.clear labeled_ipatt + let _ = Gram.Entry.clear let_binding + let _ = Gram.Entry.clear meth_list + let _ = Gram.Entry.clear module_binding + let _ = Gram.Entry.clear module_binding0 + let _ = Gram.Entry.clear module_binding_quot + let _ = Gram.Entry.clear module_declaration + let _ = Gram.Entry.clear module_expr + let _ = Gram.Entry.clear module_expr_quot + let _ = Gram.Entry.clear module_longident + let _ = Gram.Entry.clear module_longident_with_app + let _ = Gram.Entry.clear module_rec_declaration + let _ = Gram.Entry.clear module_type + let _ = Gram.Entry.clear module_type_quot + let _ = Gram.Entry.clear more_ctyp + let _ = Gram.Entry.clear name_tags + let _ = Gram.Entry.clear opt_as_lident + let _ = Gram.Entry.clear opt_class_self_patt + let _ = Gram.Entry.clear opt_class_self_type + let _ = Gram.Entry.clear opt_comma_ctyp + let _ = Gram.Entry.clear opt_dot_dot + let _ = Gram.Entry.clear opt_eq_ctyp + let _ = Gram.Entry.clear opt_expr + let _ = Gram.Entry.clear opt_meth_list + let _ = Gram.Entry.clear opt_mutable + let _ = Gram.Entry.clear opt_polyt + let _ = Gram.Entry.clear opt_private + let _ = Gram.Entry.clear opt_rec + let _ = Gram.Entry.clear opt_virtual + let _ = Gram.Entry.clear opt_when_expr + let _ = Gram.Entry.clear patt + let _ = Gram.Entry.clear patt_as_patt_opt + let _ = Gram.Entry.clear patt_eoi + let _ = Gram.Entry.clear patt_quot + let _ = Gram.Entry.clear patt_tcon + let _ = Gram.Entry.clear phrase + let _ = Gram.Entry.clear pipe_ctyp + let _ = Gram.Entry.clear poly_type + let _ = Gram.Entry.clear row_field + let _ = Gram.Entry.clear sem_ctyp + let _ = Gram.Entry.clear sem_expr + let _ = Gram.Entry.clear sem_expr_for_list + let _ = Gram.Entry.clear sem_patt + let _ = Gram.Entry.clear sem_patt_for_list + let _ = Gram.Entry.clear semi + let _ = Gram.Entry.clear sequence + let _ = Gram.Entry.clear sig_item + let _ = Gram.Entry.clear sig_item_quot + let _ = Gram.Entry.clear sig_items + let _ = Gram.Entry.clear star_ctyp + let _ = Gram.Entry.clear str_item + let _ = Gram.Entry.clear str_item_quot + let _ = Gram.Entry.clear str_items + let _ = Gram.Entry.clear top_phrase + let _ = Gram.Entry.clear type_constraint + let _ = Gram.Entry.clear type_declaration + let _ = Gram.Entry.clear type_ident_and_parameters + let _ = Gram.Entry.clear type_kind + let _ = Gram.Entry.clear type_longident + let _ = Gram.Entry.clear type_longident_and_parameters + let _ = Gram.Entry.clear type_parameter + let _ = Gram.Entry.clear type_parameters + let _ = Gram.Entry.clear typevars + let _ = Gram.Entry.clear use_file + let _ = Gram.Entry.clear val_longident + let _ = Gram.Entry.clear value_let + let _ = Gram.Entry.clear value_val + let _ = Gram.Entry.clear with_constr + let _ = Gram.Entry.clear with_constr_quot + let neg_string n = + let len = String.length n + in + if (len > 0) && (n.[0] = '-') + then String.sub n 1 (len - 1) + else "-" ^ n + let mkumin _loc f arg = + match arg with + | Ast.ExInt (_, n) -> Ast.ExInt (_loc, neg_string n) + | Ast.ExInt32 (_, n) -> Ast.ExInt32 (_loc, neg_string n) + | Ast.ExInt64 (_, n) -> Ast.ExInt64 (_loc, neg_string n) + | Ast.ExNativeInt (_, n) -> Ast.ExNativeInt (_loc, neg_string n) + | Ast.ExFlo (_, n) -> Ast.ExFlo (_loc, neg_string n) + | _ -> + Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdLid (_loc, "~" ^ f)), + arg) + let mklistexp _loc last = + let rec loop top = + function + | [] -> + (match last with + | Some e -> e + | None -> Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))) + | e1 :: el -> + let _loc = + if top then _loc else Loc.merge (Ast.loc_of_expr e1) _loc + in + Ast.ExApp (_loc, + Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "::")), + e1), + loop false el) + in loop true + let mkassert _loc = + function + | Ast.ExId (_, (Ast.IdUid (_, "False"))) -> Ast.ExAsf _loc + | (* this case take care about + the special assert false node *) + e -> Ast.ExAsr (_loc, e) + let append_eLem el e = el @ [ e ] + let mk_anti ?(c = "") n s = "\\$" ^ (n ^ (c ^ (":" ^ s))) + let mksequence _loc = + function + | (Ast.ExSem (_, _, _) | Ast.ExAnt (_, _) as e) -> + Ast.ExSeq (_loc, e) + | e -> e + let bigarray_get _loc arr arg = + let coords = + match arg with + | Ast.ExTup (_, (Ast.ExCom (_, e1, e2))) | Ast.ExCom (_, e1, e2) + -> Ast.list_of_expr e1 (Ast.list_of_expr e2 []) + | _ -> [ arg ] + in + match coords with + | [ c1 ] -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Bigarray"), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Array1"), + Ast.IdLid (_loc, "get")))), + arr), + c1) + | [ c1; c2 ] -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Bigarray"), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Array2"), + Ast.IdLid (_loc, "get")))), + arr), + c1), + c2) + | [ c1; c2; c3 ] -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Bigarray"), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Array3"), + Ast.IdLid (_loc, "get")))), + arr), + c1), + c2), + c3) + | (* | coords -> <:expr< Bigarray.Genarray.get $arr$ [| $`list:coords$ |] >> ] *) + coords -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Bigarray"), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Genarray"), + Ast.IdLid (_loc, "get")))), + arr), + Ast.ExArr (_loc, Ast.exSem_of_list coords)) + let bigarray_set _loc var newval = + match var with + | Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Bigarray")), + (Ast.IdAcc (_, (Ast.IdUid (_, "Array1")), + (Ast.IdLid (_, "get")))))))), + arr)), + c1) -> + Some + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Bigarray"), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Array1"), + Ast.IdLid (_loc, "set")))), + arr), + c1), + newval)) + | Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Bigarray")), + (Ast.IdAcc (_, (Ast.IdUid (_, "Array2")), + (Ast.IdLid (_, "get")))))))), + arr)), + c1)), + c2) -> + Some + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Bigarray"), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Array2"), + Ast.IdLid (_loc, "set")))), + arr), + c1), + c2), + newval)) + | Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Bigarray")), + (Ast.IdAcc (_, (Ast.IdUid (_, "Array3")), + (Ast.IdLid (_, "get")))))))), + arr)), + c1)), + c2)), + c3) -> + Some + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Bigarray"), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Array3"), + Ast.IdLid (_loc, "set")))), + arr), + c1), + c2), + c3), + newval)) + | Ast.ExApp (_, + (Ast.ExApp (_, + (Ast.ExId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Bigarray")), + (Ast.IdAcc (_, (Ast.IdUid (_, "Genarray")), + (Ast.IdLid (_, "get")))))))), + arr)), + (Ast.ExArr (_, coords))) -> + Some + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Bigarray"), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Genarray"), + Ast.IdLid (_loc, "set")))), + arr), + Ast.ExArr (_loc, coords)), + newval)) + | _ -> None + let choose_tvar tpl = + let abs = "abstract" in + let rec find_alpha n = + let ns = if n = 0 then "" else string_of_int n in + let s' = abs ^ ns in + let rec mem = + function + | (Ast.TyQuo (_, s) | Ast.TyQuP (_, s) | Ast.TyQuM (_, s)) :: + xs -> (s = s') || (mem xs) + | [] -> false + | _ -> assert false + in if mem tpl then find_alpha (succ n) else s' + in find_alpha 0 + let stopped_at _loc = Some (Loc.move_line 1 _loc) + (* FIXME be more precise *) + (* value list1sep symb sep one cons = + let rec kont al = + parser + [ [: v = sep; a = symb; s :] -> kont (cons al (one a)) s + | [: :] -> al ] + in + parser [: a = symb; s :] -> kont (one a) s; + + value sem_expr = + list1sep expr ";" (fun x -> x) (fun e1 e2 -> <:expr< $e1$; $e2$ >>) *) + (* transmit the context *) + let _ = + Gram.Entry.setup_parser sem_expr + (let symb = Gram.parse_tokens_after_filter expr in + let rec kont al (__strm : _ Stream.t) = + match Stream.peek __strm with + | Some ((KEYWORD ";", _loc)) -> + (Stream.junk __strm; + let a = + (try symb __strm + with | Stream.Failure -> raise (Stream.Error "")) in + let s = __strm in kont (Ast.ExSem (_loc, al, a)) s) + | _ -> al + in + fun (__strm : _ Stream.t) -> + let a = symb __strm in kont a __strm) + (* sem_expr_for_list: + [ [ e = expr; ";"; el = SELF -> fun acc -> <:expr< [ $e$ :: $el acc$ ] >> + | e = expr -> fun acc -> <:expr< [ $e$ :: $acc$ ] >> + ] ] + ; + comma_expr: + [ [ e1 = SELF; ","; e2 = SELF -> <:expr< $e1$, $e2$ >> + | e = expr -> e ] ] + ; *) + let _ = + let _ = (a_CHAR : 'a_CHAR Gram.Entry.t) + and _ = (with_constr_quot : 'with_constr_quot Gram.Entry.t) + and _ = (with_constr : 'with_constr Gram.Entry.t) + and _ = (value_val : 'value_val Gram.Entry.t) + and _ = (value_let : 'value_let Gram.Entry.t) + and _ = (val_longident : 'val_longident Gram.Entry.t) + and _ = (use_file : 'use_file Gram.Entry.t) + and _ = (typevars : 'typevars Gram.Entry.t) + and _ = (type_parameters : 'type_parameters Gram.Entry.t) + and _ = (type_parameter : 'type_parameter Gram.Entry.t) + and _ = + (type_longident_and_parameters : + 'type_longident_and_parameters Gram.Entry.t) + and _ = (type_longident : 'type_longident Gram.Entry.t) + and _ = (type_kind : 'type_kind Gram.Entry.t) + and _ = + (type_ident_and_parameters : + 'type_ident_and_parameters Gram.Entry.t) + and _ = (type_declaration : 'type_declaration Gram.Entry.t) + and _ = (type_constraint : 'type_constraint Gram.Entry.t) + and _ = (top_phrase : 'top_phrase Gram.Entry.t) + and _ = (str_items : 'str_items Gram.Entry.t) + and _ = (str_item_quot : 'str_item_quot Gram.Entry.t) + and _ = (str_item : 'str_item Gram.Entry.t) + and _ = (star_ctyp : 'star_ctyp Gram.Entry.t) + and _ = (sig_items : 'sig_items Gram.Entry.t) + and _ = (sig_item_quot : 'sig_item_quot Gram.Entry.t) + and _ = (sig_item : 'sig_item Gram.Entry.t) + and _ = (sequence : 'sequence Gram.Entry.t) + and _ = (semi : 'semi Gram.Entry.t) + and _ = (sem_patt_for_list : 'sem_patt_for_list Gram.Entry.t) + and _ = (sem_patt : 'sem_patt Gram.Entry.t) + and _ = (sem_expr_for_list : 'sem_expr_for_list Gram.Entry.t) + and _ = (sem_expr : 'sem_expr Gram.Entry.t) + and _ = (sem_ctyp : 'sem_ctyp Gram.Entry.t) + and _ = (row_field : 'row_field Gram.Entry.t) + and _ = (poly_type : 'poly_type Gram.Entry.t) + and _ = (pipe_ctyp : 'pipe_ctyp Gram.Entry.t) + and _ = (phrase : 'phrase Gram.Entry.t) + and _ = (patt_tcon : 'patt_tcon Gram.Entry.t) + and _ = (patt_quot : 'patt_quot Gram.Entry.t) + and _ = (patt_eoi : 'patt_eoi Gram.Entry.t) + and _ = (patt_as_patt_opt : 'patt_as_patt_opt Gram.Entry.t) + and _ = (patt : 'patt Gram.Entry.t) + and _ = (opt_when_expr : 'opt_when_expr Gram.Entry.t) + and _ = (opt_virtual : 'opt_virtual Gram.Entry.t) + and _ = (opt_rec : 'opt_rec Gram.Entry.t) + and _ = (opt_private : 'opt_private Gram.Entry.t) + and _ = (opt_polyt : 'opt_polyt Gram.Entry.t) + and _ = (opt_mutable : 'opt_mutable Gram.Entry.t) + and _ = (opt_meth_list : 'opt_meth_list Gram.Entry.t) + and _ = (opt_expr : 'opt_expr Gram.Entry.t) + and _ = (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t) + and _ = (opt_dot_dot : 'opt_dot_dot Gram.Entry.t) + and _ = (opt_comma_ctyp : 'opt_comma_ctyp Gram.Entry.t) + and _ = (opt_class_self_type : 'opt_class_self_type Gram.Entry.t) + and _ = (opt_class_self_patt : 'opt_class_self_patt Gram.Entry.t) + and _ = (opt_as_lident : 'opt_as_lident Gram.Entry.t) + and _ = (name_tags : 'name_tags Gram.Entry.t) + and _ = (more_ctyp : 'more_ctyp Gram.Entry.t) + and _ = (module_type_quot : 'module_type_quot Gram.Entry.t) + and _ = (module_type : 'module_type Gram.Entry.t) + and _ = + (module_rec_declaration : 'module_rec_declaration Gram.Entry.t) + and _ = + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t) + and _ = (module_longident : 'module_longident Gram.Entry.t) + and _ = (module_expr_quot : 'module_expr_quot Gram.Entry.t) + and _ = (module_expr : 'module_expr Gram.Entry.t) + and _ = (module_declaration : 'module_declaration Gram.Entry.t) + and _ = (module_binding_quot : 'module_binding_quot Gram.Entry.t) + and _ = (module_binding0 : 'module_binding0 Gram.Entry.t) + and _ = (module_binding : 'module_binding Gram.Entry.t) + and _ = (meth_list : 'meth_list Gram.Entry.t) + and _ = (let_binding : 'let_binding Gram.Entry.t) + and _ = (labeled_ipatt : 'labeled_ipatt Gram.Entry.t) + and _ = (label_patt : 'label_patt Gram.Entry.t) + and _ = (label_longident : 'label_longident Gram.Entry.t) + and _ = (label_ipatt : 'label_ipatt Gram.Entry.t) + and _ = (label_expr : 'label_expr Gram.Entry.t) + and _ = (label_declaration : 'label_declaration Gram.Entry.t) + and _ = (label : 'label Gram.Entry.t) + and _ = (ipatt_tcon : 'ipatt_tcon Gram.Entry.t) + and _ = (ipatt : 'ipatt Gram.Entry.t) + and _ = (interf : 'interf Gram.Entry.t) + and _ = (implem : 'implem Gram.Entry.t) + and _ = (ident_quot : 'ident_quot Gram.Entry.t) + and _ = (ident : 'ident Gram.Entry.t) + and _ = (fun_def : 'fun_def Gram.Entry.t) + and _ = (fun_binding : 'fun_binding Gram.Entry.t) + and _ = (field_expr : 'field_expr Gram.Entry.t) + and _ = (field : 'field Gram.Entry.t) + and _ = (expr_quot : 'expr_quot Gram.Entry.t) + and _ = (expr_eoi : 'expr_eoi Gram.Entry.t) + and _ = (expr : 'expr Gram.Entry.t) + and _ = (eq_expr : 'eq_expr Gram.Entry.t) + and _ = (dummy : 'dummy Gram.Entry.t) + and _ = (direction_flag : 'direction_flag Gram.Entry.t) + and _ = (cvalue_binding : 'cvalue_binding Gram.Entry.t) + and _ = (ctyp_quot : 'ctyp_quot Gram.Entry.t) + and _ = (ctyp : 'ctyp Gram.Entry.t) + and _ = + (constructor_declarations : + 'constructor_declarations Gram.Entry.t) + and _ = + (constructor_declaration : 'constructor_declaration Gram.Entry.t) + and _ = (constructor_arg_list : 'constructor_arg_list Gram.Entry.t) + and _ = (constrain : 'constrain Gram.Entry.t) + and _ = (comma_type_parameter : 'comma_type_parameter Gram.Entry.t) + and _ = (comma_patt : 'comma_patt Gram.Entry.t) + and _ = (comma_ipatt : 'comma_ipatt Gram.Entry.t) + and _ = (comma_expr : 'comma_expr Gram.Entry.t) + and _ = (comma_ctyp : 'comma_ctyp Gram.Entry.t) + and _ = (class_type_quot : 'class_type_quot Gram.Entry.t) + and _ = (class_type_plus : 'class_type_plus Gram.Entry.t) + and _ = + (class_type_longident_and_param : + 'class_type_longident_and_param Gram.Entry.t) + and _ = (class_type_longident : 'class_type_longident Gram.Entry.t) + and _ = + (class_type_declaration : 'class_type_declaration Gram.Entry.t) + and _ = (class_type : 'class_type Gram.Entry.t) + and _ = (class_structure : 'class_structure Gram.Entry.t) + and _ = (class_str_item_quot : 'class_str_item_quot Gram.Entry.t) + and _ = (class_str_item : 'class_str_item Gram.Entry.t) + and _ = (class_signature : 'class_signature Gram.Entry.t) + and _ = (class_sig_item_quot : 'class_sig_item_quot Gram.Entry.t) + and _ = (class_sig_item : 'class_sig_item Gram.Entry.t) + and _ = (class_name_and_param : 'class_name_and_param Gram.Entry.t) + and _ = + (class_longident_and_param : + 'class_longident_and_param Gram.Entry.t) + and _ = (class_longident : 'class_longident Gram.Entry.t) + and _ = + (class_info_for_class_type : + 'class_info_for_class_type Gram.Entry.t) + and _ = + (class_info_for_class_expr : + 'class_info_for_class_expr Gram.Entry.t) + and _ = (class_fun_def : 'class_fun_def Gram.Entry.t) + and _ = (class_fun_binding : 'class_fun_binding Gram.Entry.t) + and _ = (class_expr_quot : 'class_expr_quot Gram.Entry.t) + and _ = (class_expr : 'class_expr Gram.Entry.t) + and _ = (class_description : 'class_description Gram.Entry.t) + and _ = (class_declaration : 'class_declaration Gram.Entry.t) + and _ = (binding_quot : 'binding_quot Gram.Entry.t) + and _ = (binding : 'binding Gram.Entry.t) + and _ = (match_case_quot : 'match_case_quot Gram.Entry.t) + and _ = (match_case0 : 'match_case0 Gram.Entry.t) + and _ = (match_case : 'match_case Gram.Entry.t) + and _ = (and_ctyp : 'and_ctyp Gram.Entry.t) + and _ = (amp_ctyp : 'amp_ctyp Gram.Entry.t) + and _ = (a_ident : 'a_ident Gram.Entry.t) + and _ = (a_UIDENT : 'a_UIDENT Gram.Entry.t) + and _ = (a_STRING : 'a_STRING Gram.Entry.t) + and _ = (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t) + and _ = (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t) + and _ = (a_LIDENT_or_operator : 'a_LIDENT_or_operator Gram.Entry.t) + and _ = (a_LIDENT : 'a_LIDENT Gram.Entry.t) + and _ = (a_LABEL : 'a_LABEL Gram.Entry.t) + and _ = (a_INT64 : 'a_INT64 Gram.Entry.t) + and _ = (a_INT32 : 'a_INT32 Gram.Entry.t) + and _ = (a_INT : 'a_INT Gram.Entry.t) + and _ = (a_FLOAT : 'a_FLOAT Gram.Entry.t) + in + (Gram.extend (module_expr : 'module_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "struct"; + Gram.Snterm + (Gram.Entry.obj + (str_items : 'str_items Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (st : 'str_items) _ (_loc : Loc.t) -> + (Ast.MeStr (_loc, st) : 'module_expr)))); + ([ Gram.Skeyword "functor"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword ")"; Gram.Skeyword "->"; Gram.Sself ], + (Gram.Action.mk + (fun (me : 'module_expr) _ _ (t : 'module_type) + _ (i : 'a_UIDENT) _ _ (_loc : Loc.t) -> + (Ast.MeFun (_loc, i, t, me) : 'module_expr)))) ]); + (None, None, + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (me2 : 'module_expr) (me1 : 'module_expr) + (_loc : Loc.t) -> + (Ast.MeApp (_loc, me1, me2) : 'module_expr)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (me : 'module_expr) _ (_loc : Loc.t) -> + (me : 'module_expr)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (mt : 'module_type) _ (me : 'module_expr) + _ (_loc : Loc.t) -> + (Ast.MeTyc (_loc, me, mt) : 'module_expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'module_longident) (_loc : Loc.t) -> + (Ast.MeId (_loc, i) : 'module_expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "mexp" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"mexp\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "mexp" | "anti" | "list" as n)), + s) -> + (Ast.MeAnt (_loc, + mk_anti ~c: "module_expr" n s) : + 'module_expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (str_item : 'str_item Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Loc.t) -> + (Ast.StExp (_loc, e) : 'str_item)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "stri" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"stri\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "stri" | "anti" | "list" as n)), + s) -> + (Ast.StAnt (_loc, + mk_anti ~c: "str_item" n s) : + 'str_item) + | _ -> assert false))); + ([ Gram.Skeyword "class"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (class_type_declaration : + 'class_type_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ctd : 'class_type_declaration) _ _ + (_loc : Loc.t) -> + (Ast.StClt (_loc, ctd) : 'str_item)))); + ([ Gram.Skeyword "class"; + Gram.Snterm + (Gram.Entry.obj + (class_declaration : + 'class_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (cd : 'class_declaration) _ (_loc : Loc.t) + -> (Ast.StCls (_loc, cd) : 'str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_let : 'value_let Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (bi : 'binding) (r : 'opt_rec) _ + (_loc : Loc.t) -> + (Ast.StVal (_loc, r, bi) : 'str_item)))); + ([ Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (type_declaration : + 'type_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (td : 'type_declaration) _ (_loc : Loc.t) + -> (Ast.StTyp (_loc, td) : 'str_item)))); + ([ Gram.Skeyword "open"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'module_longident) _ (_loc : Loc.t) -> + (Ast.StOpn (_loc, i) : 'str_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (i : 'a_UIDENT) _ _ + (_loc : Loc.t) -> + (Ast.StMty (_loc, i, mt) : 'str_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "rec"; + Gram.Snterm + (Gram.Entry.obj + (module_binding : + 'module_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mb : 'module_binding) _ _ (_loc : Loc.t) + -> (Ast.StRecMod (_loc, mb) : 'str_item)))); + ([ Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (module_binding0 : + 'module_binding0 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mb : 'module_binding0) (i : 'a_UIDENT) _ + (_loc : Loc.t) -> + (Ast.StMod (_loc, i, mb) : 'str_item)))); + ([ Gram.Skeyword "include"; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (_loc : Loc.t) -> + (Ast.StInc (_loc, me) : 'str_item)))); + ([ Gram.Skeyword "external"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (a_STRING : 'a_STRING Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_STRING) _ (t : 'ctyp) _ + (i : 'a_LIDENT) _ (_loc : Loc.t) -> + (Ast.StExt (_loc, i, t, s) : 'str_item)))); + ([ Gram.Skeyword "exception"; + Gram.Snterm + (Gram.Entry.obj + (constructor_declaration : + 'constructor_declaration Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (type_longident : + 'type_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'type_longident) _ + (t : 'constructor_declaration) _ + (_loc : Loc.t) -> + (Ast.StExc (_loc, t, Ast.OSome i) : + 'str_item)))); + ([ Gram.Skeyword "exception"; + Gram.Snterm + (Gram.Entry.obj + (constructor_declaration : + 'constructor_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'constructor_declaration) _ + (_loc : Loc.t) -> + (Ast.StExc (_loc, t, Ast.ONone) : 'str_item)))) ]) ])) + ()); + Gram.extend (module_binding0 : 'module_binding0 Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (_loc : Loc.t) -> + (me : 'module_binding0)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) _ + (_loc : Loc.t) -> + (Ast.MeTyc (_loc, me, mt) : 'module_binding0)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword ")"; Gram.Sself ], + (Gram.Action.mk + (fun (mb : 'module_binding0) _ + (mt : 'module_type) _ (m : 'a_UIDENT) _ + (_loc : Loc.t) -> + (Ast.MeFun (_loc, m, mt, mb) : + 'module_binding0)))) ]) ])) + ()); + Gram.extend (module_binding : 'module_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) _ + (m : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.MbColEq (_loc, m, mt, me) : + 'module_binding)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) _ + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), m) -> + (Ast.MbColEq (_loc, mk_anti n m, mt, me) : + 'module_binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), s) -> + (Ast.MbAnt (_loc, + mk_anti ~c: "module_binding" n s) : + 'module_binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("module_binding" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"module_binding\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("module_binding" | "anti" | "list" as + n)), + s) -> + (Ast.MbAnt (_loc, + mk_anti ~c: "module_binding" n s) : + 'module_binding) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'module_binding) _ + (b1 : 'module_binding) (_loc : Loc.t) -> + (Ast.MbAnd (_loc, b1, b2) : 'module_binding)))) ]) ])) + ()); + Gram.extend (module_type : 'module_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "functor"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself; Gram.Skeyword ")"; + Gram.Skeyword "->"; Gram.Sself ], + (Gram.Action.mk + (fun (mt : 'module_type) _ _ (t : 'module_type) + _ (i : 'a_UIDENT) _ _ (_loc : Loc.t) -> + (Ast.MtFun (_loc, i, t, mt) : 'module_type)))) ]); + (None, None, + [ ([ Gram.Sself; Gram.Skeyword "with"; + Gram.Snterm + (Gram.Entry.obj + (with_constr : 'with_constr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (wc : 'with_constr) _ (mt : 'module_type) + (_loc : Loc.t) -> + (Ast.MtWit (_loc, mt, wc) : 'module_type)))) ]); + (None, None, + [ ([ Gram.Skeyword "sig"; + Gram.Snterm + (Gram.Entry.obj + (sig_items : 'sig_items Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (sg : 'sig_items) _ (_loc : Loc.t) -> + (Ast.MtSig (_loc, sg) : 'module_type)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (mt : 'module_type) _ (_loc : Loc.t) -> + (mt : 'module_type)))); + ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Loc.t) -> + (Ast.MtQuo (_loc, i) : 'module_type)))); + ([ Gram.Snterm + (Gram.Entry.obj + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'module_longident_with_app) + (_loc : Loc.t) -> + (Ast.MtId (_loc, i) : 'module_type)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "mtyp" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"mtyp\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "mtyp" | "anti" | "list" as n)), + s) -> + (Ast.MtAnt (_loc, + mk_anti ~c: "module_type" n s) : + 'module_type) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (sig_item : 'sig_item Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), None, + [ ([ (* | "external"; i = a_LIDENT; ":"; t = ctyp; "="; pd = LIST1 [ x = STRING -> x ] -> *) + Gram.Skeyword "class"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (class_type_declaration : + 'class_type_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ctd : 'class_type_declaration) _ _ + (_loc : Loc.t) -> + (Ast.SgClt (_loc, ctd) : 'sig_item)))); + ([ Gram.Skeyword "class"; + Gram.Snterm + (Gram.Entry.obj + (class_description : + 'class_description Gram.Entry.t)) ], + (Gram.Action.mk + (fun (cd : 'class_description) _ (_loc : Loc.t) + -> (Ast.SgCls (_loc, cd) : 'sig_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT_or_operator : + 'a_LIDENT_or_operator Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (i : 'a_LIDENT_or_operator) _ + (_loc : Loc.t) -> + (Ast.SgVal (_loc, i, t) : 'sig_item)))); + ([ Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (type_declaration : + 'type_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'type_declaration) _ (_loc : Loc.t) -> + (Ast.SgTyp (_loc, t) : 'sig_item)))); + ([ Gram.Skeyword "open"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'module_longident) _ (_loc : Loc.t) -> + (Ast.SgOpn (_loc, i) : 'sig_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (i : 'a_UIDENT) _ _ + (_loc : Loc.t) -> + (Ast.SgMty (_loc, i, mt) : 'sig_item)))); + ([ Gram.Skeyword "module"; Gram.Skeyword "rec"; + Gram.Snterm + (Gram.Entry.obj + (module_rec_declaration : + 'module_rec_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mb : 'module_rec_declaration) _ _ + (_loc : Loc.t) -> + (Ast.SgRecMod (_loc, mb) : 'sig_item)))); + ([ Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (module_declaration : + 'module_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_declaration) (i : 'a_UIDENT) + _ (_loc : Loc.t) -> + (Ast.SgMod (_loc, i, mt) : 'sig_item)))); + ([ Gram.Skeyword "include"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (_loc : Loc.t) -> + (Ast.SgInc (_loc, mt) : 'sig_item)))); + ([ Gram.Skeyword "external"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (a_STRING : 'a_STRING Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_STRING) _ (t : 'ctyp) _ + (i : 'a_LIDENT) _ (_loc : Loc.t) -> + (Ast.SgExt (_loc, i, t, s) : 'sig_item)))); + ([ Gram.Skeyword "exception"; + Gram.Snterm + (Gram.Entry.obj + (constructor_declaration : + 'constructor_declaration Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'constructor_declaration) _ + (_loc : Loc.t) -> + (Ast.SgExc (_loc, t) : 'sig_item)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "sigi" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"sigi\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "sigi" | "anti" | "list" as n)), + s) -> + (Ast.SgAnt (_loc, + mk_anti ~c: "sig_item" n s) : + 'sig_item) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (module_declaration : 'module_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword ")"; Gram.Sself ], + (Gram.Action.mk + (fun (mt : 'module_declaration) _ + (t : 'module_type) _ (i : 'a_UIDENT) _ + (_loc : Loc.t) -> + (Ast.MtFun (_loc, i, t, mt) : + 'module_declaration)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (_loc : Loc.t) -> + (mt : 'module_declaration)))) ]) ])) + ()); + Gram.extend + (module_rec_declaration : + 'module_rec_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (m : 'a_UIDENT) + (_loc : Loc.t) -> + (Ast.MbCol (_loc, m, mt) : + 'module_rec_declaration)))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "module_binding" | "anti" | + "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"module_binding\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "module_binding" | "anti" | + "list" + as n)), + s) -> + (Ast.MbAnt (_loc, + mk_anti ~c: "module_binding" n s) : + 'module_rec_declaration) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (m2 : 'module_rec_declaration) _ + (m1 : 'module_rec_declaration) (_loc : Loc.t) + -> + (Ast.MbAnd (_loc, m1, m2) : + 'module_rec_declaration)))) ]) ])) + ()); + Gram.extend (with_constr : 'with_constr Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (module_longident : + 'module_longident Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i2 : 'module_longident_with_app) _ + (i1 : 'module_longident) _ (_loc : Loc.t) -> + (Ast.WcMod (_loc, i1, i2) : 'with_constr)))); + ([ Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj + (type_longident_and_parameters : + 'type_longident_and_parameters Gram.Entry. + t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ + (t1 : 'type_longident_and_parameters) _ + (_loc : Loc.t) -> + (Ast.WcTyp (_loc, t1, t2) : 'with_constr)))); + ([ Gram.Skeyword "type"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), s) + -> + (Ast.WcTyp (_loc, + Ast.TyAnt (_loc, + mk_anti ~c: "ctyp" n s), + t) : + 'with_constr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "with_constr" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"with_constr\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "with_constr" | "anti" | "list" + as n)), + s) -> + (Ast.WcAnt (_loc, + mk_anti ~c: "with_constr" n s) : + 'with_constr) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (wc2 : 'with_constr) _ (wc1 : 'with_constr) + (_loc : Loc.t) -> + (Ast.WcAnd (_loc, wc1, wc2) : 'with_constr)))) ]) ])) + ()); + Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "object"; + Gram.Snterm + (Gram.Entry.obj + (opt_class_self_patt : + 'opt_class_self_patt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_structure : + 'class_structure Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (cst : 'class_structure) + (csp : 'opt_class_self_patt) _ (_loc : Loc.t) + -> (Ast.ExObj (_loc, csp, cst) : 'expr)))); + ([ Gram.Skeyword "while"; Gram.Sself; + Gram.Skeyword "do"; Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (seq : 'sequence) _ _ (e : 'expr) _ + (_loc : Loc.t) -> + (Ast.ExWhi (_loc, e, seq) : 'expr)))); + ([ Gram.Skeyword "for"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword "="; Gram.Sself; + Gram.Snterm + (Gram.Entry.obj + (direction_flag : + 'direction_flag Gram.Entry.t)); + Gram.Sself; Gram.Skeyword "do"; + Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (seq : 'sequence) _ _ (e2 : 'expr) + (df : 'direction_flag) (e1 : 'expr) _ + (i : 'a_LIDENT) _ (_loc : Loc.t) -> + (Ast.ExFor (_loc, i, e1, e2, df, seq) : + 'expr)))); + ([ Gram.Skeyword "do"; Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (sequence : 'sequence Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (seq : 'sequence) _ _ (_loc : Loc.t) -> + (mksequence _loc seq : 'expr)))); + ([ Gram.Skeyword "if"; Gram.Sself; + Gram.Skeyword "then"; Gram.Sself; + Gram.Skeyword "else"; Gram.Sself ], + (Gram.Action.mk + (fun (e3 : 'expr) _ (e2 : 'expr) _ (e1 : 'expr) + _ (_loc : Loc.t) -> + (Ast.ExIfe (_loc, e1, e2, e3) : 'expr)))); + ([ Gram.Skeyword "try"; Gram.Sself; + Gram.Skeyword "with"; + Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); + Gram.Skeyword "->"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (p : 'ipatt) _ (e1 : 'expr) + _ (_loc : Loc.t) -> + (Ast.ExTry (_loc, e1, + Ast.McArr (_loc, p, Ast.ExNil _loc, e2)) : + 'expr)))); + ([ Gram.Skeyword "try"; Gram.Sself; + Gram.Skeyword "with"; Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (match_case : 'match_case Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (a : 'match_case) _ _ (e : 'expr) _ + (_loc : Loc.t) -> + (Ast.ExTry (_loc, e, a) : 'expr)))); + ([ Gram.Skeyword "match"; Gram.Sself; + Gram.Skeyword "with"; + Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); + Gram.Skeyword "->"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (p : 'ipatt) _ (e1 : 'expr) + _ (_loc : Loc.t) -> + (Ast.ExMat (_loc, e1, + Ast.McArr (_loc, p, Ast.ExNil _loc, e2)) : + 'expr)))); + ([ Gram.Skeyword "match"; Gram.Sself; + Gram.Skeyword "with"; Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (match_case : 'match_case Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (a : 'match_case) _ _ (e : 'expr) _ + (_loc : Loc.t) -> + (Ast.ExMat (_loc, e, a) : 'expr)))); + ([ Gram.Skeyword "fun"; + Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (fun_def : 'fun_def Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_def) (p : 'labeled_ipatt) _ + (_loc : Loc.t) -> + (Ast.ExFun (_loc, + Ast.McArr (_loc, p, Ast.ExNil _loc, e)) : + 'expr)))); + ([ Gram.Skeyword "fun"; Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (match_case : 'match_case Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (a : 'match_case) _ _ (_loc : Loc.t) -> + (Ast.ExFun (_loc, a) : 'expr)))); + ([ Gram.Skeyword "let"; Gram.Skeyword "module"; + Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (module_binding0 : + 'module_binding0 Gram.Entry.t)); + Gram.Skeyword "in"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (mb : 'module_binding0) + (m : 'a_UIDENT) _ _ (_loc : Loc.t) -> + (Ast.ExLmd (_loc, m, mb, e) : 'expr)))); + ([ Gram.Skeyword "let"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)); + Gram.Skeyword "in"; Gram.Sself ], + (Gram.Action.mk + (fun (x : 'expr) _ (bi : 'binding) + (r : 'opt_rec) _ (_loc : Loc.t) -> + (Ast.ExLet (_loc, r, bi, x) : 'expr)))) ]); + ((Some "where"), None, + [ ([ Gram.Sself; Gram.Skeyword "where"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (let_binding : 'let_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (lb : 'let_binding) (rf : 'opt_rec) _ + (e : 'expr) (_loc : Loc.t) -> + (Ast.ExLet (_loc, rf, lb, e) : 'expr)))) ]); + ((Some ":="), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Sself; Gram.Skeyword ":="; Gram.Sself; + Gram.Snterm + (Gram.Entry.obj (dummy : 'dummy Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (e2 : 'expr) _ (e1 : 'expr) + (_loc : Loc.t) -> + (match bigarray_set _loc e1 e2 with + | Some e -> e + | None -> Ast.ExAss (_loc, e1, e2) : 'expr)))) ]); + ((Some "||"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; Gram.Skeyword "||"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "||")), + e1), + e2) : + 'expr)))) ]); + ((Some "&&"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; Gram.Skeyword "&&"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "&&")), + e1), + e2) : + 'expr)))) ]); + ((Some "<"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "!="; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "!=")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "=="; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "==")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "<>"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "<>")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "="; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "=")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword ">="; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, ">=")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "<="; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "<=")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword ">"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, ">")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "<"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "<")), + e1), + e2) : + 'expr)))) ]); + ((Some "^"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; Gram.Skeyword "@"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "@")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "^^"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "^^")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "^"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "^")), + e1), + e2) : + 'expr)))) ]); + ((Some "+"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "-."; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "-.")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "+."; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "+.")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "-"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "-")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "+"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "+")), + e1), + e2) : + 'expr)))) ]); + ((Some "*"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "mod"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "mod")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "lxor"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdLid (_loc, "lxor")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "lor"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "lor")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "land"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdLid (_loc, "land")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "/."; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "/.")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "*."; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "*.")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "/"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "/")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "*"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "*")), + e1), + e2) : + 'expr)))) ]); + ((Some "**"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; Gram.Skeyword "lsr"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "lsr")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "lsl"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "lsl")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "asr"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "asr")), + e1), + e2) : + 'expr)))); + ([ Gram.Sself; Gram.Skeyword "**"; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "**")), + e1), + e2) : + 'expr)))) ]); + ((Some "unary minus"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Skeyword "-."; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (mkumin _loc "-." e : 'expr)))); + ([ Gram.Skeyword "-"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (mkumin _loc "-" e : 'expr)))) ]); + ((Some "apply"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "lazy"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (Ast.ExLaz (_loc, e) : 'expr)))); + ([ Gram.Skeyword "new"; + Gram.Snterm + (Gram.Entry.obj + (class_longident : + 'class_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'class_longident) _ (_loc : Loc.t) -> + (Ast.ExNew (_loc, i) : 'expr)))); + ([ Gram.Skeyword "assert"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (mkassert _loc e : 'expr)))); + ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) (e1 : 'expr) (_loc : Loc.t) -> + (Ast.ExApp (_loc, e1, e2) : 'expr)))) ]); + ((Some "label"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Skeyword "?"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) _ (_loc : Loc.t) -> + (Ast.ExOlb (_loc, i, Ast.ExNil _loc) : 'expr)))); + ([ Gram.Skeyword "?"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (i : 'a_LIDENT) _ + (_loc : Loc.t) -> + (Ast.ExOlb (_loc, i, e) : 'expr)))); + ([ Gram.Stoken + (((function | OPTLABEL _ -> true | _ -> false), + "OPTLABEL _")); + Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | OPTLABEL i -> + (Ast.ExOlb (_loc, i, e) : 'expr) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) _ (_loc : Loc.t) -> + (Ast.ExLab (_loc, i, Ast.ExNil _loc) : 'expr)))); + ([ Gram.Stoken + (((function | LABEL _ -> true | _ -> false), + "LABEL _")); + Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | LABEL i -> (Ast.ExLab (_loc, i, e) : 'expr) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (i : 'a_LIDENT) _ + (_loc : Loc.t) -> + (Ast.ExLab (_loc, i, e) : 'expr)))) ]); + ((Some "."), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)) ], + (Gram.Action.mk + (fun (lab : 'label) _ (e : 'expr) (_loc : Loc.t) + -> (Ast.ExSnd (_loc, e, lab) : 'expr)))); + ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'expr) _ (e1 : 'expr) (_loc : Loc.t) + -> (Ast.ExAcc (_loc, e1, e2) : 'expr)))); + ([ Gram.Sself; Gram.Skeyword "."; Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (comma_expr : 'comma_expr Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (e2 : 'comma_expr) _ _ (e1 : 'expr) + (_loc : Loc.t) -> + (bigarray_get _loc e1 e2 : 'expr)))); + ([ Gram.Sself; Gram.Skeyword "."; Gram.Skeyword "["; + Gram.Sself; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (e2 : 'expr) _ _ (e1 : 'expr) + (_loc : Loc.t) -> + (Ast.ExSte (_loc, e1, e2) : 'expr)))); + ([ Gram.Sself; Gram.Skeyword "."; Gram.Skeyword "("; + Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e2 : 'expr) _ _ (e1 : 'expr) + (_loc : Loc.t) -> + (Ast.ExAre (_loc, e1, e2) : 'expr)))) ]); + ((Some "~-"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Skeyword "~-."; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "~-.")), + e) : + 'expr)))); + ([ Gram.Skeyword "~-"; Gram.Sself ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "~-")), + e) : + 'expr)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'expr) _ (_loc : Loc.t) -> + (e : 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (e : 'expr) _ + (_loc : Loc.t) -> + (Ast.ExCoe (_loc, e, Ast.TyNil _loc, t) : + 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t2 : 'ctyp) _ (t : 'ctyp) _ (e : 'expr) + _ (_loc : Loc.t) -> + (Ast.ExCoe (_loc, e, t, t2) : 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_expr : 'comma_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (el : 'comma_expr) _ (e : 'expr) _ + (_loc : Loc.t) -> + (Ast.ExTup (_loc, Ast.ExCom (_loc, e, el)) : + 'expr)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (e : 'expr) _ + (_loc : Loc.t) -> + (Ast.ExTyc (_loc, e, t) : 'expr)))); + ([ Gram.Skeyword "("; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (Ast.ExId (_loc, Ast.IdUid (_loc, "()")) : + 'expr)))); + ([ Gram.Skeyword "{<"; + Gram.Snterm + (Gram.Entry.obj + (field_expr : 'field_expr Gram.Entry.t)); + Gram.Skeyword ">}" ], + (Gram.Action.mk + (fun _ (fel : 'field_expr) _ (_loc : Loc.t) -> + (Ast.ExOvr (_loc, fel) : 'expr)))); + ([ Gram.Skeyword "{<"; Gram.Skeyword ">}" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (Ast.ExOvr (_loc, Ast.BiNil _loc) : 'expr)))); + ([ Gram.Skeyword "{"; Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword ")"; Gram.Skeyword "with"; + Gram.Snterm + (Gram.Entry.obj + (label_expr : 'label_expr Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (el : 'label_expr) _ _ (e : 'expr) _ _ + (_loc : Loc.t) -> + (Ast.ExRec (_loc, el, e) : 'expr)))); + ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (label_expr : 'label_expr Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (el : 'label_expr) _ (_loc : Loc.t) -> + (Ast.ExRec (_loc, el, Ast.ExNil _loc) : + 'expr)))); + ([ Gram.Skeyword "[|"; + Gram.Snterm + (Gram.Entry.obj + (sem_expr : 'sem_expr Gram.Entry.t)); + Gram.Skeyword "|]" ], + (Gram.Action.mk + (fun _ (el : 'sem_expr) _ (_loc : Loc.t) -> + (Ast.ExArr (_loc, el) : 'expr)))); + ([ Gram.Skeyword "[|"; Gram.Skeyword "|]" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (Ast.ExArr (_loc, Ast.ExNil _loc) : 'expr)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (sem_expr_for_list : + 'sem_expr_for_list Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (mk_list : 'sem_expr_for_list) _ + (_loc : Loc.t) -> + (mk_list + (Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))) : + 'expr)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (sem_expr_for_list : + 'sem_expr_for_list Gram.Entry.t)); + Gram.Skeyword "::"; Gram.Sself; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (last : 'expr) _ + (mk_list : 'sem_expr_for_list) _ + (_loc : Loc.t) -> (mk_list last : 'expr)))); + ([ Gram.Skeyword "["; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (Ast.ExId (_loc, Ast.IdUid (_loc, "[]")) : + 'expr)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_ident) _ (_loc : Loc.t) -> + (Ast.ExVrn (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (val_longident : + 'val_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'val_longident) (_loc : Loc.t) -> + (Ast.ExId (_loc, i) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj (a_CHAR : 'a_CHAR Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_CHAR) (_loc : Loc.t) -> + (Ast.ExChr (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_STRING : 'a_STRING Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_STRING) (_loc : Loc.t) -> + (Ast.ExStr (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_FLOAT) (_loc : Loc.t) -> + (Ast.ExFlo (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_NATIVEINT) (_loc : Loc.t) -> + (Ast.ExNativeInt (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_INT64 : 'a_INT64 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT64) (_loc : Loc.t) -> + (Ast.ExInt64 (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_INT32 : 'a_INT32 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT32) (_loc : Loc.t) -> + (Ast.ExInt32 (_loc, s) : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT) (_loc : Loc.t) -> + (Ast.ExInt (_loc, s) : 'expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("tup", _) -> true + | _ -> false), + "ANTIQUOT (\"tup\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("tup" as n)), s) -> + (Ast.ExTup (_loc, + Ast.ExAnt (_loc, + mk_anti ~c: "expr" n s)) : + 'expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("exp" | "" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"exp\" | \"\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("exp" | "" | "anti" as n)), s) + -> + (Ast.ExAnt (_loc, mk_anti ~c: "expr" n s) : + 'expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function | QUOTATION _ -> true | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand_expr + (Gram.parse_string expr) _loc x : + 'expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (* sem_expr: + [ [ e1 = SELF; ";"; e2 = SELF -> <:expr< $e1$; $e2$ >> + | e = expr -> e ] ] + ; *) + (sem_expr_for_list : 'sem_expr_for_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Loc.t) -> + (fun acc -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdUid (_loc, "::")), + e), + acc) : + 'sem_expr_for_list)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (el : 'sem_expr_for_list) _ (e : 'expr) + (_loc : Loc.t) -> + (fun acc -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdUid (_loc, "::")), + e), + el acc) : + 'sem_expr_for_list)))) ]) ])) + ()); + Gram.extend (comma_expr : 'comma_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Loc.t) -> + (e : 'comma_expr)))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (e2 : 'comma_expr) _ (e1 : 'comma_expr) + (_loc : Loc.t) -> + (Ast.ExCom (_loc, e1, e2) : 'comma_expr)))) ]) ])) + ()); + Gram.extend (dummy : 'dummy Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> (() : 'dummy)))) ]) ])) + ()); + Gram.extend (sequence : 'sequence Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Loc.t) -> + (e : 'sequence)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (e : 'expr) (_loc : Loc.t) -> + (e : 'sequence)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (el : 'sequence) _ (e : 'expr) + (_loc : Loc.t) -> + (Ast.ExSem (_loc, e, el) : 'sequence)))); + ([ Gram.Skeyword "let"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)); + Gram.srules sequence + [ ([ Gram.Skeyword ";" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) (_loc : Loc.t) -> + (Token.extract_string x : 'e__1)))); + ([ Gram.Skeyword "in" ], + (Gram.Action.mk + (fun (x : Gram.Token.t) (_loc : Loc.t) -> + (Token.extract_string x : 'e__1)))) ]; + Gram.Sself ], + (Gram.Action.mk + (fun (el : 'sequence) _ (bi : 'binding) + (rf : 'opt_rec) _ (_loc : Loc.t) -> + (Ast.ExLet (_loc, rf, bi, mksequence _loc el) : + 'sequence)))) ]) ])) + ()); + Gram.extend (binding : 'binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (let_binding : 'let_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (b : 'let_binding) (_loc : Loc.t) -> + (b : 'binding)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'binding) _ (b1 : 'binding) + (_loc : Loc.t) -> + (Ast.BiAnd (_loc, b1, b2) : 'binding)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.BiAnt (_loc, + mk_anti ~c: "binding" n s) : + 'binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.BiEq (_loc, + Ast.PaAnt (_loc, + mk_anti ~c: "patt" n s), + e) : + 'binding) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("binding" | "list"), _) -> true + | _ -> false), + "ANTIQUOT ((\"binding\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("binding" | "list" as n)), s) + -> + (Ast.BiAnt (_loc, + mk_anti ~c: "binding" n s) : + 'binding) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (let_binding : 'let_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (fun_binding : 'fun_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_binding) (p : 'ipatt) + (_loc : Loc.t) -> + (Ast.BiEq (_loc, p, e) : 'let_binding)))) ]) ])) + ()); + Gram.extend (fun_binding : 'fun_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t : 'ctyp) _ (_loc : Loc.t) + -> + (Ast.ExCoe (_loc, e, Ast.TyNil _loc, t) : + 'fun_binding)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t : 'ctyp) _ (_loc : Loc.t) + -> (Ast.ExTyc (_loc, e, t) : 'fun_binding)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (e : 'fun_binding)))); + ([ Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e : 'fun_binding) (p : 'labeled_ipatt) + (_loc : Loc.t) -> + (Ast.ExFun (_loc, + Ast.McArr (_loc, p, Ast.ExNil _loc, e)) : + 'fun_binding)))) ]) ])) + ()); + Gram.extend (match_case : 'match_case Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0sep + (Gram.Snterm + (Gram.Entry.obj + (match_case0 : 'match_case0 Gram.Entry.t)), + Gram.Skeyword "|") ], + (Gram.Action.mk + (fun (l : 'match_case0 list) (_loc : Loc.t) -> + (Ast.mcOr_of_list l : 'match_case)))) ]) ])) + ()); + Gram.extend (match_case0 : 'match_case0 Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (patt_as_patt_opt : + 'patt_as_patt_opt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_when_expr : + 'opt_when_expr Gram.Entry.t)); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (w : 'opt_when_expr) + (p : 'patt_as_patt_opt) (_loc : Loc.t) -> + (Ast.McArr (_loc, p, w, e) : 'match_case0)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")); + Gram.Skeyword "when"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (w : 'expr) _ + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.McArr (_loc, + Ast.PaAnt (_loc, + mk_anti ~c: "patt" n s), + w, e) : + 'match_case0) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.McArr (_loc, + Ast.PaAnt (_loc, + mk_anti ~c: "patt" n s), + Ast.ExNil _loc, e) : + 'match_case0) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "anti" as n)), s) -> + (Ast.McAnt (_loc, + mk_anti ~c: "match_case" n s) : + 'match_case0) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("match_case" | "list"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"match_case\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("match_case" | "list" as n)), + s) -> + (Ast.McAnt (_loc, + mk_anti ~c: "match_case" n s) : + 'match_case0) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (opt_when_expr : 'opt_when_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.ExNil _loc : 'opt_when_expr)))); + ([ Gram.Skeyword "when"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (w : 'expr) _ (_loc : Loc.t) -> + (w : 'opt_when_expr)))) ]) ])) + ()); + Gram.extend (patt_as_patt_opt : 'patt_as_patt_opt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Loc.t) -> + (p : 'patt_as_patt_opt)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword "as"; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p2 : 'patt) _ (p1 : 'patt) (_loc : Loc.t) + -> + (Ast.PaAli (_loc, p1, p2) : + 'patt_as_patt_opt)))) ]) ])) + ()); + Gram.extend (label_expr : 'label_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (fun_binding : 'fun_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_binding) (p : 'label_longident) + (_loc : Loc.t) -> + (Ast.BiEq (_loc, Ast.PaId (_loc, p), e) : + 'label_expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.BiAnt (_loc, + mk_anti ~c: "binding;" n s) : + 'label_expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "binding" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"binding\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "binding" | "anti" as n)), + s) -> + (Ast.BiAnt (_loc, + mk_anti ~c: "binding" n s) : + 'label_expr) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'label_expr) _ (b1 : 'label_expr) + (_loc : Loc.t) -> + (Ast.BiSem (_loc, b1, b2) : 'label_expr)))) ]) ])) + ()); + Gram.extend (fun_def : 'fun_def Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (e : 'fun_def)))); + ([ Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (e : 'fun_def) (p : 'labeled_ipatt) + (_loc : Loc.t) -> + (Ast.ExFun (_loc, + Ast.McArr (_loc, p, Ast.ExNil _loc, e)) : + 'fun_def)))) ]) ])) + ()); + Gram.extend (patt : 'patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'patt) _ (p1 : 'patt) (_loc : Loc.t) + -> (Ast.PaOrp (_loc, p1, p2) : 'patt)))) ]); + (None, (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Sself; Gram.Skeyword ".."; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'patt) _ (p1 : 'patt) (_loc : Loc.t) + -> (Ast.PaRng (_loc, p1, p2) : 'patt)))) ]); + (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'patt) (p1 : 'patt) (_loc : Loc.t) -> + (Ast.PaApp (_loc, p1, p2) : 'patt)))) ]); + ((Some "simple"), None, + [ ([ (* | i = opt_label; "("; p = patt_tcon; ")" -> *) + (* <:patt< ? $i$ : ($p$) >> *) Gram.Skeyword "?"; + Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (patt_tcon : 'patt_tcon Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'expr) _ (p : 'patt_tcon) _ _ + (_loc : Loc.t) -> + (Ast.PaOlbi (_loc, "", p, e) : 'patt)))); + ([ Gram.Skeyword "?"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (patt_tcon : 'patt_tcon Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'patt_tcon) _ _ (_loc : Loc.t) -> + (Ast.PaOlb (_loc, "", p) : 'patt)))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaOlb (_loc, mk_anti n i, + Ast.PaNil _loc) : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | LIDENT i -> + (Ast.PaOlb (_loc, i, Ast.PaNil _loc) : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")); + Gram.Skeyword ":"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (patt_tcon : 'patt_tcon Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (eq_expr : 'eq_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (f : 'eq_expr) (p : 'patt_tcon) _ _ + (__camlp4_0 : Gram.Token.t) _ (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (f (mk_anti n i) p : 'patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function | OPTLABEL _ -> true | _ -> false), + "OPTLABEL _")); + Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (patt_tcon : 'patt_tcon Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (eq_expr : 'eq_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (f : 'eq_expr) (p : 'patt_tcon) _ + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | OPTLABEL i -> (f i p : 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | LIDENT i -> + (Ast.PaLab (_loc, i, Ast.PaNil _loc) : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaLab (_loc, mk_anti n i, + Ast.PaNil _loc) : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (p : 'patt) _ (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaLab (_loc, mk_anti n i, p) : + 'patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function | LABEL _ -> true | _ -> false), + "LABEL _")); + Gram.Sself ], + (Gram.Action.mk + (fun (p : 'patt) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | LABEL i -> (Ast.PaLab (_loc, i, p) : 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (type_longident : + 'type_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'type_longident) _ (_loc : Loc.t) -> + (Ast.PaTyp (_loc, i) : 'patt)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_ident) _ (_loc : Loc.t) -> + (Ast.PaVrn (_loc, s) : 'patt)))); + ([ Gram.Stoken + (((function | QUOTATION _ -> true | _ -> false), + "QUOTATION _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | QUOTATION x -> + (Quotation.expand_patt + (Gram.parse_string patt) _loc x : + 'patt) + | _ -> assert false))); + ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.PaAny _loc : 'patt)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_patt : 'comma_patt Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (pl : 'comma_patt) _ (p : 'patt) _ + (_loc : Loc.t) -> + (Ast.PaTup (_loc, Ast.PaCom (_loc, p, pl)) : + 'patt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword "as"; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p2 : 'patt) _ (p : 'patt) _ + (_loc : Loc.t) -> + (Ast.PaAli (_loc, p, p2) : 'patt)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (p : 'patt) _ + (_loc : Loc.t) -> + (Ast.PaTyc (_loc, p, t) : 'patt)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'patt) _ (_loc : Loc.t) -> + (p : 'patt)))); + ([ Gram.Skeyword "("; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (Ast.PaId (_loc, Ast.IdUid (_loc, "()")) : + 'patt)))); + ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (label_patt : 'label_patt Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (pl : 'label_patt) _ (_loc : Loc.t) -> + (Ast.PaRec (_loc, pl) : 'patt)))); + ([ Gram.Skeyword "[|"; + Gram.Snterm + (Gram.Entry.obj + (sem_patt : 'sem_patt Gram.Entry.t)); + Gram.Skeyword "|]" ], + (Gram.Action.mk + (fun _ (pl : 'sem_patt) _ (_loc : Loc.t) -> + (Ast.PaArr (_loc, pl) : 'patt)))); + ([ Gram.Skeyword "[|"; Gram.Skeyword "|]" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (Ast.PaArr (_loc, Ast.PaNil _loc) : 'patt)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (sem_patt_for_list : + 'sem_patt_for_list Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (mk_list : 'sem_patt_for_list) _ + (_loc : Loc.t) -> + (mk_list + (Ast.PaId (_loc, Ast.IdUid (_loc, "[]"))) : + 'patt)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (sem_patt_for_list : + 'sem_patt_for_list Gram.Entry.t)); + Gram.Skeyword "::"; Gram.Sself; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (last : 'patt) _ + (mk_list : 'sem_patt_for_list) _ + (_loc : Loc.t) -> (mk_list last : 'patt)))); + ([ Gram.Skeyword "["; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (Ast.PaId (_loc, Ast.IdUid (_loc, "[]")) : + 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj + (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_FLOAT) _ (_loc : Loc.t) -> + (Ast.PaFlo (_loc, neg_string s) : 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj + (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_NATIVEINT) _ (_loc : Loc.t) -> + (Ast.PaNativeInt (_loc, neg_string s) : + 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj + (a_INT64 : 'a_INT64 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT64) _ (_loc : Loc.t) -> + (Ast.PaInt64 (_loc, neg_string s) : 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj + (a_INT32 : 'a_INT32 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT32) _ (_loc : Loc.t) -> + (Ast.PaInt32 (_loc, neg_string s) : 'patt)))); + ([ Gram.Skeyword "-"; + Gram.Snterm + (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT) _ (_loc : Loc.t) -> + (Ast.PaInt (_loc, neg_string s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj (a_CHAR : 'a_CHAR Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_CHAR) (_loc : Loc.t) -> + (Ast.PaChr (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_STRING : 'a_STRING Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_STRING) (_loc : Loc.t) -> + (Ast.PaStr (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_FLOAT : 'a_FLOAT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_FLOAT) (_loc : Loc.t) -> + (Ast.PaFlo (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_NATIVEINT) (_loc : Loc.t) -> + (Ast.PaNativeInt (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_INT64 : 'a_INT64 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT64) (_loc : Loc.t) -> + (Ast.PaInt64 (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_INT32 : 'a_INT32 Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT32) (_loc : Loc.t) -> + (Ast.PaInt32 (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj (a_INT : 'a_INT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_INT) (_loc : Loc.t) -> + (Ast.PaInt (_loc, s) : 'patt)))); + ([ Gram.Snterm + (Gram.Entry.obj (ident : 'ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'ident) (_loc : Loc.t) -> + (Ast.PaId (_loc, i) : 'patt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("tup", _) -> true + | _ -> false), + "ANTIQUOT (\"tup\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("tup" as n)), s) -> + (Ast.PaTup (_loc, + Ast.PaAnt (_loc, + mk_anti ~c: "patt" n s)) : + 'patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "pat" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "pat" | "anti" as n)), s) + -> + (Ast.PaAnt (_loc, mk_anti ~c: "patt" n s) : + 'patt) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (comma_patt : 'comma_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Loc.t) -> + (p : 'comma_patt)))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'comma_patt) _ (p1 : 'comma_patt) + (_loc : Loc.t) -> + (Ast.PaCom (_loc, p1, p2) : 'comma_patt)))) ]) ])) + ()); + Gram.extend (sem_patt : 'sem_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Loc.t) -> + (p : 'sem_patt)))); + ([ Gram.Sself; Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'sem_patt) _ (p1 : 'sem_patt) + (_loc : Loc.t) -> + (Ast.PaSem (_loc, p1, p2) : 'sem_patt)))) ]) ])) + ()); + Gram.extend + (sem_patt_for_list : 'sem_patt_for_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Loc.t) -> + (fun acc -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdUid (_loc, "::")), + p), + acc) : + 'sem_patt_for_list)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (pl : 'sem_patt_for_list) _ (p : 'patt) + (_loc : Loc.t) -> + (fun acc -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdUid (_loc, "::")), + p), + pl acc) : + 'sem_patt_for_list)))) ]) ])) + ()); + Gram.extend (label_patt : 'label_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) _ (i : 'label_longident) + (_loc : Loc.t) -> + (Ast.PaEq (_loc, Ast.PaId (_loc, i), p) : + 'label_patt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.PaAnt (_loc, + mk_anti ~c: "patt;" n s) : + 'label_patt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "pat" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "pat" | "anti" as n)), s) + -> + (Ast.PaAnt (_loc, mk_anti ~c: "patt" n s) : + 'label_patt) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'label_patt) _ (p1 : 'label_patt) + (_loc : Loc.t) -> + (Ast.PaSem (_loc, p1, p2) : 'label_patt)))) ]) ])) + ()); + Gram.extend (ipatt : 'ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.PaAny _loc : 'ipatt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_LIDENT) (_loc : Loc.t) -> + (Ast.PaId (_loc, Ast.IdLid (_loc, s)) : + 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_ipatt : 'comma_ipatt Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (pl : 'comma_ipatt) _ (p : 'ipatt) _ + (_loc : Loc.t) -> + (Ast.PaTup (_loc, Ast.PaCom (_loc, p, pl)) : + 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Sself; + Gram.Skeyword "as"; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p2 : 'ipatt) _ (p : 'ipatt) _ + (_loc : Loc.t) -> + (Ast.PaAli (_loc, p, p2) : 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (p : 'ipatt) _ + (_loc : Loc.t) -> + (Ast.PaTyc (_loc, p, t) : 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'ipatt) _ (_loc : Loc.t) -> + (p : 'ipatt)))); + ([ Gram.Skeyword "("; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (Ast.PaId (_loc, Ast.IdUid (_loc, "()")) : + 'ipatt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("tup", _) -> true + | _ -> false), + "ANTIQUOT (\"tup\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("tup" as n)), s) -> + (Ast.PaTup (_loc, + Ast.PaAnt (_loc, + mk_anti ~c: "patt" n s)) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "pat" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "pat" | "anti" as n)), s) + -> + (Ast.PaAnt (_loc, mk_anti ~c: "patt" n s) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (label_ipatt : 'label_ipatt Gram.Entry.t)); + Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ (pl : 'label_ipatt) _ (_loc : Loc.t) -> + (Ast.PaRec (_loc, pl) : 'ipatt)))) ]) ])) + ()); + Gram.extend (labeled_ipatt : 'labeled_ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'ipatt) (_loc : Loc.t) -> + (p : 'labeled_ipatt)))) ]) ])) + ()); + Gram.extend (comma_ipatt : 'comma_ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'ipatt) (_loc : Loc.t) -> + (p : 'comma_ipatt)))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'comma_ipatt) _ (p1 : 'comma_ipatt) + (_loc : Loc.t) -> + (Ast.PaCom (_loc, p1, p2) : 'comma_ipatt)))) ]) ])) + ()); + Gram.extend (label_ipatt : 'label_ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'ipatt) _ (i : 'label_longident) + (_loc : Loc.t) -> + (Ast.PaEq (_loc, Ast.PaId (_loc, i), p) : + 'label_ipatt)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "pat" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"pat\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "pat" | "anti" as n)), s) + -> + (Ast.PaAnt (_loc, mk_anti ~c: "patt" n s) : + 'label_ipatt) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'label_ipatt) _ (p1 : 'label_ipatt) + (_loc : Loc.t) -> + (Ast.PaSem (_loc, p1, p2) : 'label_ipatt)))) ]) ])) + ()); + Gram.extend (type_declaration : 'type_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_ident_and_parameters : + 'type_ident_and_parameters Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t)); + Gram.Slist0 + (Gram.Snterm + (Gram.Entry.obj + (constrain : 'constrain Gram.Entry.t))) ], + (Gram.Action.mk + (fun (cl : 'constrain list) (tk : 'opt_eq_ctyp) + ((n, tpl) : 'type_ident_and_parameters) + (_loc : Loc.t) -> + (Ast.TyDcl (_loc, n, tpl, tk tpl, cl) : + 'type_declaration)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'type_declaration) _ + (t1 : 'type_declaration) (_loc : Loc.t) -> + (Ast.TyAnd (_loc, t1, t2) : + 'type_declaration)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + mk_anti ~c: "ctypand" n s) : + 'type_declaration) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), s) + -> + (Ast.TyAnt (_loc, mk_anti ~c: "ctyp" n s) : + 'type_declaration) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (constrain : 'constrain Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "constraint"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ + (_loc : Loc.t) -> ((t1, t2) : 'constrain)))) ]) ])) + ()); + Gram.extend (opt_eq_ctyp : 'opt_eq_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (fun tpl -> Ast.TyQuo (_loc, choose_tvar tpl) : + 'opt_eq_ctyp)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (type_kind : 'type_kind Gram.Entry.t)) ], + (Gram.Action.mk + (fun (tk : 'type_kind) _ (_loc : Loc.t) -> + (fun _ -> tk : 'opt_eq_ctyp)))) ]) ])) + ()); + Gram.extend (type_kind : 'type_kind Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'type_kind)))) ]) ])) + ()); + Gram.extend + (type_ident_and_parameters : + 'type_ident_and_parameters Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Slist0 + (Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t))) ], + (Gram.Action.mk + (fun (tpl : 'type_parameter list) + (i : 'a_LIDENT) (_loc : Loc.t) -> + ((i, tpl) : 'type_ident_and_parameters)))) ]) ])) + ()); + Gram.extend + (type_longident_and_parameters : + 'type_longident_and_parameters Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_longident : + 'type_longident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (type_parameters : + 'type_parameters Gram.Entry.t)) ], + (Gram.Action.mk + (fun (tpl : 'type_parameters) + (i : 'type_longident) (_loc : Loc.t) -> + (tpl (Ast.TyId (_loc, i)) : + 'type_longident_and_parameters)))) ]) ])) + ()); + Gram.extend (type_parameters : 'type_parameters Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (fun t -> t : 'type_parameters)))); + ([ Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'type_parameter) (_loc : Loc.t) -> + (fun acc -> Ast.TyApp (_loc, acc, t) : + 'type_parameters)))); + ([ Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'type_parameters) + (t1 : 'type_parameter) (_loc : Loc.t) -> + (fun acc -> t2 (Ast.TyApp (_loc, acc, t1)) : + 'type_parameters)))) ]) ])) + ()); + Gram.extend (type_parameter : 'type_parameter Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "-"; Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ _ (_loc : Loc.t) -> + (Ast.TyQuM (_loc, i) : 'type_parameter)))); + ([ Gram.Skeyword "+"; Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ _ (_loc : Loc.t) -> + (Ast.TyQuP (_loc, i) : 'type_parameter)))); + ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Loc.t) -> + (Ast.TyQuo (_loc, i) : 'type_parameter)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), s) + -> + (Ast.TyAnt (_loc, mk_anti n s) : + 'type_parameter) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (ctyp : 'ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "=="; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (_loc : Loc.t) + -> (Ast.TyMan (_loc, t1, t2) : 'ctyp)))) ]); + (None, (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Skeyword "private"; + Gram.Snterml + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t), + "alias") ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (_loc : Loc.t) -> + (Ast.TyPrv (_loc, t) : 'ctyp)))) ]); + ((Some "alias"), (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "as"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (_loc : Loc.t) + -> (Ast.TyAli (_loc, t1, t2) : 'ctyp)))) ]); + (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "!"; + Gram.Snterm + (Gram.Entry.obj + (typevars : 'typevars Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'typevars) _ + (_loc : Loc.t) -> + (Ast.TyPol (_loc, t1, t2) : 'ctyp)))) ]); + ((Some "arrow"), (Some Camlp4.Sig.Grammar.RightA), + [ ([ Gram.Sself; Gram.Skeyword "->"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (_loc : Loc.t) + -> (Ast.TyArr (_loc, t1, t2) : 'ctyp)))) ]); + ((Some "label"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (t : 'ctyp) (i : 'a_OPTLABEL) + (_loc : Loc.t) -> + (Ast.TyOlb (_loc, i, t) : 'ctyp)))); + ([ Gram.Skeyword "?"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ + (_loc : Loc.t) -> + (Ast.TyOlb (_loc, i, t) : 'ctyp)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LABEL : 'a_LABEL Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (t : 'ctyp) (i : 'a_LABEL) (_loc : Loc.t) + -> (Ast.TyLab (_loc, i, t) : 'ctyp)))); + ([ Gram.Skeyword "~"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (i : 'a_LIDENT) _ + (_loc : Loc.t) -> + (Ast.TyLab (_loc, i, t) : 'ctyp)))) ]); + (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) (t1 : 'ctyp) (_loc : Loc.t) -> + (let t = Ast.TyApp (_loc, t1, t2) + in + try Ast.TyId (_loc, Ast.ident_of_ctyp t) + with | Invalid_argument _ -> t : + 'ctyp)))) ]); + (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (_loc : Loc.t) + -> + (try + Ast.TyId (_loc, + Ast.IdAcc (_loc, Ast.ident_of_ctyp t1, + Ast.ident_of_ctyp t2)) + with + | Invalid_argument s -> + raise (Stream.Error s) : + 'ctyp)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "<"; + Gram.Snterm + (Gram.Entry.obj + (opt_meth_list : + 'opt_meth_list Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_dot_dot : 'opt_dot_dot Gram.Entry.t)); + Gram.Skeyword ">" ], + (Gram.Action.mk + (fun _ (v : 'opt_dot_dot) (ml : 'opt_meth_list) + _ (_loc : Loc.t) -> + (Ast.TyObj (_loc, ml, v) : 'ctyp)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (class_longident : + 'class_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'class_longident) _ (_loc : Loc.t) -> + (Ast.TyCls (_loc, i) : 'ctyp)))); + ([ Gram.Skeyword "{"; + Gram.Snterm + (Gram.Entry.obj + (label_declaration : + 'label_declaration Gram.Entry.t)); + Gram.Sopt (Gram.Skeyword ";"); Gram.Skeyword "}" ], + (Gram.Action.mk + (fun _ _ (t : 'label_declaration) _ + (_loc : Loc.t) -> + (Ast.TyRec (_loc, t) : 'ctyp)))); + ([ Gram.Skeyword "[<"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword ">"; + Gram.Snterm + (Gram.Entry.obj + (name_tags : 'name_tags Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (ntl : 'name_tags) _ (rfl : 'row_field) _ + (_loc : Loc.t) -> + (Ast.TyVrnInfSup (_loc, rfl, ntl) : 'ctyp)))); + ([ Gram.Skeyword "[<"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rfl : 'row_field) _ (_loc : Loc.t) -> + (Ast.TyVrnInf (_loc, rfl) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword "<"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword ">"; + Gram.Snterm + (Gram.Entry.obj + (name_tags : 'name_tags Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (ntl : 'name_tags) _ (rfl : 'row_field) _ + _ (_loc : Loc.t) -> + (Ast.TyVrnInfSup (_loc, rfl, ntl) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword "<"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rfl : 'row_field) _ _ (_loc : Loc.t) -> + (Ast.TyVrnInf (_loc, rfl) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword ">"; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rfl : 'row_field) _ _ (_loc : Loc.t) -> + (Ast.TyVrnSup (_loc, rfl) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword ">"; + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ _ _ (_loc : Loc.t) -> + (Ast.TyVrnSup (_loc, Ast.TyNil _loc) : 'ctyp)))); + ([ Gram.Skeyword "["; Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (row_field : 'row_field Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rfl : 'row_field) _ _ (_loc : Loc.t) -> + (Ast.TyVrnEq (_loc, rfl) : 'ctyp)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (constructor_declarations : + 'constructor_declarations Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (t : 'constructor_declarations) _ + (_loc : Loc.t) -> + (Ast.TySum (_loc, t) : 'ctyp)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (_loc : Loc.t) -> + (t : 'ctyp)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword "*"; + Gram.Snterm + (Gram.Entry.obj + (star_ctyp : 'star_ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (tl : 'star_ctyp) _ (t : 'ctyp) _ + (_loc : Loc.t) -> + (Ast.TyTup (_loc, Ast.TySta (_loc, t, tl)) : + 'ctyp)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.TyId (_loc, Ast.IdUid (_loc, i)) : + 'ctyp)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (Ast.TyId (_loc, Ast.IdLid (_loc, i)) : + 'ctyp)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("id", _) -> true + | _ -> false), + "ANTIQUOT (\"id\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("id" as n)), s) -> + (Ast.TyId (_loc, + Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s)) : + 'ctyp) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("tup", _) -> true + | _ -> false), + "ANTIQUOT (\"tup\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("tup" as n)), s) -> + (Ast.TyTup (_loc, + Ast.TyAnt (_loc, + mk_anti ~c: "ctyp" n s)) : + 'ctyp) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" | "anti" as n)), s) + -> + (Ast.TyAnt (_loc, mk_anti ~c: "ctyp" n s) : + 'ctyp) + | _ -> assert false))); + ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.TyAny _loc : 'ctyp)))); + ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Loc.t) -> + (Ast.TyQuo (_loc, i) : 'ctyp)))) ]) ])) + ()); + Gram.extend (star_ctyp : 'star_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'star_ctyp)))); + ([ Gram.Sself; Gram.Skeyword "*"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'star_ctyp) _ (t1 : 'star_ctyp) + (_loc : Loc.t) -> + (Ast.TySta (_loc, t1, t2) : 'star_ctyp)))) ]) ])) + ()); + Gram.extend + (constructor_declarations : + 'constructor_declarations Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist1sep + (Gram.Snterm + (Gram.Entry.obj + (constructor_declaration : + 'constructor_declaration Gram.Entry.t)), + Gram.Skeyword "|") ], + (Gram.Action.mk + (fun (l : 'constructor_declaration list) + (_loc : Loc.t) -> + (Ast.tyOr_of_list l : + 'constructor_declarations)))) ]) ])) + ()); + Gram.extend + (constructor_declaration : + 'constructor_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.TyId (_loc, Ast.IdUid (_loc, s)) : + 'constructor_declaration)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'constructor_arg_list) _ + (s : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.TyOf (_loc, + Ast.TyId (_loc, Ast.IdUid (_loc, s)), t) : + 'constructor_declaration)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, mk_anti ~c: "ctyp" n s) : + 'constructor_declaration) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (constructor_arg_list : 'constructor_arg_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'constructor_arg_list)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'constructor_arg_list) _ + (t1 : 'constructor_arg_list) (_loc : Loc.t) + -> + (Ast.TyAnd (_loc, t1, t2) : + 'constructor_arg_list)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.TyAnt (_loc, + mk_anti ~c: "ctypand" n s) : + 'constructor_arg_list) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (label_declaration : 'label_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; Gram.Skeyword "mutable"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ _ (s : 'a_LIDENT) + (_loc : Loc.t) -> + (Ast.TyCol (_loc, + Ast.TyId (_loc, Ast.IdLid (_loc, s)), + Ast.TyMut (_loc, t)) : + 'label_declaration)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (s : 'a_LIDENT) + (_loc : Loc.t) -> + (Ast.TyCol (_loc, + Ast.TyId (_loc, Ast.IdLid (_loc, s)), t) : + 'label_declaration)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, mk_anti ~c: "ctyp" n s) : + 'label_declaration) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'label_declaration) _ + (t1 : 'label_declaration) (_loc : Loc.t) -> + (Ast.TySem (_loc, t1, t2) : + 'label_declaration)))) ]) ])) + ()); + Gram.extend (a_ident : 'a_ident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Loc.t) -> + (i : 'a_ident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (i : 'a_ident)))) ]) ])) + ()); + Gram.extend (ident : 'ident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'ident) _ (i : 'a_UIDENT) + (_loc : Loc.t) -> + (Ast.IdAcc (_loc, Ast.IdUid (_loc, i), j) : + 'ident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (i : 'ident) _ (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), s) + -> + (Ast.IdAcc (_loc, + Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s), + i) : + 'ident) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (Ast.IdLid (_loc, i) : 'ident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.IdUid (_loc, i) : 'ident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), s) + -> + (Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s) : + 'ident) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (module_longident : 'module_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.IdUid (_loc, i) : 'module_longident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (l : 'module_longident) _ (m : 'a_UIDENT) + (_loc : Loc.t) -> + (Ast.IdAcc (_loc, Ast.IdUid (_loc, m), l) : + 'module_longident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), s) + -> + (Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s) : + 'module_longident) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (module_longident_with_app : + 'module_longident_with_app Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'module_longident_with_app) + (i : 'module_longident_with_app) + (_loc : Loc.t) -> + (Ast.IdApp (_loc, i, j) : + 'module_longident_with_app)))) ]); + (None, None, + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'module_longident_with_app) _ + (i : 'module_longident_with_app) + (_loc : Loc.t) -> + (Ast.IdAcc (_loc, i, j) : + 'module_longident_with_app)))) ]); + (None, None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (i : 'module_longident_with_app) _ + (_loc : Loc.t) -> + (i : 'module_longident_with_app)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.IdUid (_loc, i) : + 'module_longident_with_app)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), s) + -> + (Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s) : + 'module_longident_with_app) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (type_longident : 'type_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'type_longident) (i : 'type_longident) + (_loc : Loc.t) -> + (Ast.IdApp (_loc, i, j) : 'type_longident)))) ]); + (None, None, + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'type_longident) _ + (i : 'type_longident) (_loc : Loc.t) -> + (Ast.IdAcc (_loc, i, j) : 'type_longident)))) ]); + (None, None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (i : 'type_longident) _ (_loc : Loc.t) -> + (i : 'type_longident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.IdUid (_loc, i) : 'type_longident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (Ast.IdLid (_loc, i) : 'type_longident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), s) + -> + (Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s) : + 'type_longident) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (label_longident : 'label_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (Ast.IdLid (_loc, i) : 'label_longident)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (l : 'label_longident) _ (m : 'a_UIDENT) + (_loc : Loc.t) -> + (Ast.IdAcc (_loc, Ast.IdUid (_loc, m), l) : + 'label_longident)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), s) + -> + (Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s) : + 'label_longident) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (class_type_longident : 'class_type_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_longident : + 'type_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'type_longident) (_loc : Loc.t) -> + (x : 'class_type_longident)))) ]) ])) + ()); + Gram.extend (val_longident : 'val_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ident : 'ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'ident) (_loc : Loc.t) -> + (x : 'val_longident)))) ]) ])) + ()); + Gram.extend (class_longident : 'class_longident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (label_longident : + 'label_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'label_longident) (_loc : Loc.t) -> + (x : 'class_longident)))) ]) ])) + ()); + Gram.extend + (class_declaration : 'class_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_info_for_class_expr : + 'class_info_for_class_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_fun_binding : + 'class_fun_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_fun_binding) + (ci : 'class_info_for_class_expr) + (_loc : Loc.t) -> + (Ast.CeEq (_loc, ci, ce) : + 'class_declaration)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "cdcl" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"cdcl\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "cdcl" | "anti" | "list" as n)), + s) -> + (Ast.CeAnt (_loc, + mk_anti ~c: "class_expr" n s) : + 'class_declaration) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (c2 : 'class_declaration) _ + (c1 : 'class_declaration) (_loc : Loc.t) -> + (Ast.CeAnd (_loc, c1, c2) : + 'class_declaration)))) ]) ])) + ()); + Gram.extend + (class_fun_binding : 'class_fun_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (cfb : 'class_fun_binding) + (p : 'labeled_ipatt) (_loc : Loc.t) -> + (Ast.CeFun (_loc, p, cfb) : + 'class_fun_binding)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (class_type_plus : + 'class_type_plus Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_expr) _ + (ct : 'class_type_plus) _ (_loc : Loc.t) -> + (Ast.CeTyc (_loc, ce, ct) : + 'class_fun_binding)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_expr) _ (_loc : Loc.t) -> + (ce : 'class_fun_binding)))) ]) ])) + ()); + Gram.extend + (class_info_for_class_type : + 'class_info_for_class_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (opt_virtual : 'opt_virtual Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_name_and_param : + 'class_name_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((i, ot) : 'class_name_and_param) + (mv : 'opt_virtual) (_loc : Loc.t) -> + (Ast.CtCon (_loc, mv, Ast.IdLid (_loc, i), + ot) : + 'class_info_for_class_type)))) ]) ])) + ()); + Gram.extend (* <:class_type< $virtual:mv$ $lid:i$ [ $t$ ] >> *) + (* | mv = opt_virtual; i = a_LIDENT -> *) + (* Ast.CeCon (_loc, mv, Ast.IdLid (_loc, i), Ast.ONone) *) + (* <:class_type< $lid:i$ >> *) + (* [ [ "virtual"; i = a_LIDENT; "["; t = comma_type_parameter; "]" -> + <:class_type< virtual $lid:i$ [ $t$ ] >> + | "virtual"; i = a_LIDENT -> + <:class_type< virtual $lid:i$ >> + | i = a_LIDENT; "["; t = comma_type_parameter; "]" -> + <:class_type< $lid:i$ [ $t$ ] >> + | i = a_LIDENT -> <:class_type< $lid:i$ >> + ] ] + ; *) + (class_info_for_class_expr : + 'class_info_for_class_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ (* "virtual"; i = a_LIDENT; "["; t = comma_type_parameter; "]" -> *) + (* <:class_expr< virtual $lid:i$ [ $t$ ] >> *) + (* | "virtual"; i = a_LIDENT -> *) + (* <:class_expr< virtual $lid:i$ >> *) (* | *) + Gram.Snterm + (Gram.Entry.obj + (opt_virtual : 'opt_virtual Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_name_and_param : + 'class_name_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((i, ot) : 'class_name_and_param) + (mv : 'opt_virtual) (_loc : Loc.t) -> + (Ast.CeCon (_loc, mv, Ast.IdLid (_loc, i), + ot) : + 'class_info_for_class_expr)))) ]) ])) + ()); + Gram.extend (* <:class_expr< $virtual:mv$ $lid:i$ [ $t$ ] >> *) + (* <:class_expr< $lid:i$ [ $t$ ] >> *) + (* | mv = opt_virtual; i = a_LIDENT -> *) + (* Ast.CeCon (_loc, mv, Ast.IdLid (_loc, i), Ast.ONone) *) + (* <:class_expr< $lid:i$ >> *) + (class_name_and_param : 'class_name_and_param Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + ((i, (Ast.TyNil _loc)) : + 'class_name_and_param)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (comma_type_parameter : + 'comma_type_parameter Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (x : 'comma_type_parameter) _ + (i : 'a_LIDENT) (_loc : Loc.t) -> + ((i, x) : 'class_name_and_param)))) ]) ])) + ()); + Gram.extend + (comma_type_parameter : 'comma_type_parameter Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'type_parameter) (_loc : Loc.t) -> + (t : 'comma_type_parameter)))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'comma_type_parameter) _ + (t1 : 'comma_type_parameter) (_loc : Loc.t) + -> + (Ast.TyCom (_loc, t1, t2) : + 'comma_type_parameter)))) ]) ])) + ()); + Gram.extend (opt_comma_ctyp : 'opt_comma_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.TyNil _loc : 'opt_comma_ctyp)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (comma_ctyp : 'comma_ctyp Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (x : 'comma_ctyp) _ (_loc : Loc.t) -> + (x : 'opt_comma_ctyp)))) ]) ])) + ()); + Gram.extend (comma_ctyp : 'comma_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'comma_ctyp)))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'comma_ctyp) _ (t1 : 'comma_ctyp) + (_loc : Loc.t) -> + (Ast.TyCom (_loc, t1, t2) : 'comma_ctyp)))) ]) ])) + ()); + Gram.extend (class_fun_def : 'class_fun_def Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_expr) _ (_loc : Loc.t) -> + (ce : 'class_fun_def)))); + ([ Gram.Snterm + (Gram.Entry.obj + (labeled_ipatt : + 'labeled_ipatt Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (ce : 'class_fun_def) (p : 'labeled_ipatt) + (_loc : Loc.t) -> + (Ast.CeFun (_loc, p, ce) : 'class_fun_def)))) ]) ])) + ()); + Gram.extend (class_expr : 'class_expr Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), None, + [ ([ Gram.Skeyword "let"; + Gram.Snterm + (Gram.Entry.obj + (opt_rec : 'opt_rec Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)); + Gram.Skeyword "in"; Gram.Sself ], + (Gram.Action.mk + (fun (ce : 'class_expr) _ (bi : 'binding) + (rf : 'opt_rec) _ (_loc : Loc.t) -> + (Ast.CeLet (_loc, rf, bi, ce) : 'class_expr)))); + ([ Gram.Skeyword "fun"; + Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_fun_def : + 'class_fun_def Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_fun_def) (p : 'ipatt) _ + (_loc : Loc.t) -> + (Ast.CeFun (_loc, p, ce) : 'class_expr)))) ]); + ((Some "apply"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Sself; + Gram.Snterml + (Gram.Entry.obj (expr : 'expr Gram.Entry.t), + "label") ], + (Gram.Action.mk + (fun (e : 'expr) (ce : 'class_expr) + (_loc : Loc.t) -> + (Ast.CeApp (_loc, ce, e) : 'class_expr)))) ]); + ((Some "simple"), None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (ce : 'class_expr) _ (_loc : Loc.t) -> + (ce : 'class_expr)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (class_type : 'class_type Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (ct : 'class_type) _ (ce : 'class_expr) _ + (_loc : Loc.t) -> + (Ast.CeTyc (_loc, ce, ct) : 'class_expr)))); + ([ Gram.Skeyword "object"; + Gram.Snterm + (Gram.Entry.obj + (opt_class_self_patt : + 'opt_class_self_patt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_structure : + 'class_structure Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (cst : 'class_structure) + (csp : 'opt_class_self_patt) _ (_loc : Loc.t) + -> (Ast.CeStr (_loc, csp, cst) : 'class_expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_longident_and_param : + 'class_longident_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ce : 'class_longident_and_param) + (_loc : Loc.t) -> (ce : 'class_expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "cexp" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"cexp\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "cexp" | "anti" as n)), s) + -> + (Ast.CeAnt (_loc, + mk_anti ~c: "class_expr" n s) : + 'class_expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (class_longident_and_param : + 'class_longident_and_param Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_longident : + 'class_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ci : 'class_longident) (_loc : Loc.t) -> + (Ast.CeCon (_loc, Ast.BFalse, ci, + Ast.TyNil _loc) : + 'class_longident_and_param)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_longident : + 'class_longident Gram.Entry.t)); + Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (comma_ctyp : 'comma_ctyp Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (t : 'comma_ctyp) _ + (ci : 'class_longident) (_loc : Loc.t) -> + (Ast.CeCon (_loc, Ast.BFalse, ci, t) : + 'class_longident_and_param)))) ]) ])) + ()); + Gram.extend (class_structure : 'class_structure Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0 + (Gram.srules class_structure + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_str_item : + 'class_str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (cst : 'class_str_item) + (_loc : Loc.t) -> (cst : 'e__2)))) ]) ], + (Gram.Action.mk + (fun (l : 'e__2 list) (_loc : Loc.t) -> + (Ast.crSem_of_list l : 'class_structure)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "cst" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"cst\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "cst" | "anti" | "list" as n)), + s) -> + (Ast.CrAnt (_loc, + mk_anti ~c: "class_str_item" n s) : + 'class_structure) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (opt_class_self_patt : 'opt_class_self_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.PaNil _loc : 'opt_class_self_patt)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (p : 'patt) _ + (_loc : Loc.t) -> + (Ast.PaTyc (_loc, p, t) : + 'opt_class_self_patt)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'patt) _ (_loc : Loc.t) -> + (p : 'opt_class_self_patt)))) ]) ])) + ()); + Gram.extend (class_str_item : 'class_str_item Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "initializer"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (se : 'expr) _ (_loc : Loc.t) -> + (Ast.CrIni (_loc, se) : 'class_str_item)))); + ([ Gram.Skeyword "type"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ + (_loc : Loc.t) -> + (Ast.CrCtr (_loc, t1, t2) : 'class_str_item)))); + ([ Gram.Skeyword "method"; + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_polyt : 'opt_polyt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (fun_binding : 'fun_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'fun_binding) (topt : 'opt_polyt) + (l : 'label) (pf : 'opt_private) _ + (_loc : Loc.t) -> + (Ast.CrMth (_loc, l, pf, e, topt) : + 'class_str_item)))); + ([ Gram.Skeyword "method"; Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) + (pf : 'opt_private) _ _ (_loc : Loc.t) -> + (Ast.CrVir (_loc, l, pf, t) : + 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (opt_mutable : 'opt_mutable Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) + (mf : 'opt_mutable) _ _ (_loc : Loc.t) -> + (Ast.CrVvr (_loc, l, mf, t) : + 'class_str_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_mutable : 'opt_mutable Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (cvalue_binding : + 'cvalue_binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'cvalue_binding) (lab : 'label) + (mf : 'opt_mutable) _ (_loc : Loc.t) -> + (Ast.CrVal (_loc, lab, mf, e) : + 'class_str_item)))); + ([ Gram.Skeyword "inherit"; + Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_as_lident : + 'opt_as_lident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (pb : 'opt_as_lident) (ce : 'class_expr) _ + (_loc : Loc.t) -> + (Ast.CrInh (_loc, ce, pb) : 'class_str_item)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "cst" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"cst\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "cst" | "anti" | "list" as n)), + s) -> + (Ast.CrAnt (_loc, + mk_anti ~c: "class_str_item" n s) : + 'class_str_item) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (opt_as_lident : 'opt_as_lident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> ("" : 'opt_as_lident)))); + ([ Gram.Skeyword "as"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) _ (_loc : Loc.t) -> + (i : 'opt_as_lident)))) ]) ])) + ()); + Gram.extend (opt_polyt : 'opt_polyt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.TyNil _loc : 'opt_polyt)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (_loc : Loc.t) -> + (t : 'opt_polyt)))) ]) ])) + ()); + Gram.extend (cvalue_binding : 'cvalue_binding Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t : 'ctyp) _ (_loc : Loc.t) + -> + (Ast.ExCoe (_loc, e, Ast.TyNil _loc, t) : + 'cvalue_binding)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ":>"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t2 : 'ctyp) _ (t : 'ctyp) _ + (_loc : Loc.t) -> + (Ast.ExCoe (_loc, e, t, t2) : + 'cvalue_binding)))); + ([ Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (t : 'ctyp) _ (_loc : Loc.t) + -> (Ast.ExTyc (_loc, e, t) : 'cvalue_binding)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (e : 'cvalue_binding)))) ]) ])) + ()); + Gram.extend (label : 'label Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (i : 'label)))) ]) ])) + ()); + Gram.extend (class_type : 'class_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "object"; + Gram.Snterm + (Gram.Entry.obj + (opt_class_self_type : + 'opt_class_self_type Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (class_signature : + 'class_signature Gram.Entry.t)); + Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (csg : 'class_signature) + (cst : 'opt_class_self_type) _ (_loc : Loc.t) + -> (Ast.CtSig (_loc, cst, csg) : 'class_type)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_type_longident_and_param : + 'class_type_longident_and_param Gram. + Entry.t)) ], + (Gram.Action.mk + (fun (ct : 'class_type_longident_and_param) + (_loc : Loc.t) -> (ct : 'class_type)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "ctyp" | "anti"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"ctyp\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "ctyp" | "anti" as n)), s) + -> + (Ast.CtAnt (_loc, + mk_anti ~c: "class_type" n s) : + 'class_type) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (class_type_longident_and_param : + 'class_type_longident_and_param Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_type_longident : + 'class_type_longident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'class_type_longident) (_loc : Loc.t) + -> + (Ast.CtCon (_loc, Ast.BFalse, i, + Ast.TyNil _loc) : + 'class_type_longident_and_param)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_type_longident : + 'class_type_longident Gram.Entry.t)); + Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj + (comma_ctyp : 'comma_ctyp Gram.Entry.t)); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (t : 'comma_ctyp) _ + (i : 'class_type_longident) (_loc : Loc.t) -> + (Ast.CtCon (_loc, Ast.BFalse, i, t) : + 'class_type_longident_and_param)))) ]) ])) + ()); + Gram.extend (class_type_plus : 'class_type_plus Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_type : 'class_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ct : 'class_type) (_loc : Loc.t) -> + (ct : 'class_type_plus)))); + ([ Gram.Skeyword "["; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "]"; Gram.Skeyword "->"; Gram.Sself ], + (Gram.Action.mk + (fun (ct : 'class_type_plus) _ _ (t : 'ctyp) _ + (_loc : Loc.t) -> + (Ast.CtFun (_loc, t, ct) : 'class_type_plus)))) ]) ])) + ()); + Gram.extend + (opt_class_self_type : 'opt_class_self_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.TyNil _loc : 'opt_class_self_type)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 'ctyp) _ (_loc : Loc.t) -> + (t : 'opt_class_self_type)))) ]) ])) + ()); + Gram.extend (class_signature : 'class_signature Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0 + (Gram.srules class_signature + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_sig_item : + 'class_sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (csg : 'class_sig_item) + (_loc : Loc.t) -> (csg : 'e__3)))) ]) ], + (Gram.Action.mk + (fun (l : 'e__3 list) (_loc : Loc.t) -> + (Ast.cgSem_of_list l : 'class_signature)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "csg" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"csg\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "csg" | "anti" | "list" as n)), + s) -> + (Ast.CgAnt (_loc, + mk_anti ~c: "class_sig_item" n s) : + 'class_signature) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (class_sig_item : 'class_sig_item Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_constraint : + 'type_constraint Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t2 : 'ctyp) _ (t1 : 'ctyp) _ + (_loc : Loc.t) -> + (Ast.CgCtr (_loc, t1, t2) : 'class_sig_item)))); + ([ Gram.Skeyword "method"; + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) + (pf : 'opt_private) _ (_loc : Loc.t) -> + (Ast.CgMth (_loc, l, pf, t) : + 'class_sig_item)))); + ([ Gram.Skeyword "method"; Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (opt_private : 'opt_private Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (l : 'label) + (pf : 'opt_private) _ _ (_loc : Loc.t) -> + (Ast.CgVir (_loc, l, pf, t) : + 'class_sig_item)))); + ([ Gram.Snterm + (Gram.Entry.obj + (value_val : 'value_val Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_mutable : 'opt_mutable Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_virtual : 'opt_virtual Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (l : 'label) + (mv : 'opt_virtual) (mf : 'opt_mutable) _ + (_loc : Loc.t) -> + (Ast.CgVal (_loc, l, mf, mv, t) : + 'class_sig_item)))); + ([ Gram.Skeyword "inherit"; + Gram.Snterm + (Gram.Entry.obj + (class_type : 'class_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (cs : 'class_type) _ (_loc : Loc.t) -> + (Ast.CgInh (_loc, cs) : 'class_sig_item)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "csg" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"csg\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "csg" | "anti" | "list" as n)), + s) -> + (Ast.CgAnt (_loc, + mk_anti ~c: "class_sig_item" n s) : + 'class_sig_item) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (type_constraint : 'type_constraint Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "type" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'type_constraint)))) ]) ])) + ()); + Gram.extend + (class_description : 'class_description Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_info_for_class_type : + 'class_info_for_class_type Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (class_type_plus : + 'class_type_plus Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ct : 'class_type_plus) _ + (ci : 'class_info_for_class_type) + (_loc : Loc.t) -> + (Ast.CtCol (_loc, ci, ct) : + 'class_description)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "typ" | "anti" | "list" as n)), + s) -> + (Ast.CtAnt (_loc, + mk_anti ~c: "class_type" n s) : + 'class_description) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (cd2 : 'class_description) _ + (cd1 : 'class_description) (_loc : Loc.t) -> + (Ast.CtAnd (_loc, cd1, cd2) : + 'class_description)))) ]) ])) + ()); + Gram.extend + (class_type_declaration : + 'class_type_declaration Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj + (class_info_for_class_type : + 'class_info_for_class_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (class_type : 'class_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ct : 'class_type) _ + (ci : 'class_info_for_class_type) + (_loc : Loc.t) -> + (Ast.CtEq (_loc, ci, ct) : + 'class_type_declaration)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "typ" | "anti" | "list" as n)), + s) -> + (Ast.CtAnt (_loc, + mk_anti ~c: "class_type" n s) : + 'class_type_declaration) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (cd2 : 'class_type_declaration) _ + (cd1 : 'class_type_declaration) + (_loc : Loc.t) -> + (Ast.CtAnd (_loc, cd1, cd2) : + 'class_type_declaration)))) ]) ])) + ()); + Gram.extend (field_expr : 'field_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Snterm + (Gram.Entry.obj (label : 'label Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (l : 'label) (_loc : Loc.t) + -> + (Ast.BiEq (_loc, + Ast.PaId (_loc, Ast.IdLid (_loc, l)), e) : + 'field_expr)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("list", _) -> true + | _ -> false), + "ANTIQUOT (\"list\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("list" as n)), s) -> + (Ast.BiAnt (_loc, + mk_anti ~c: "binding;" n s) : + 'field_expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "bi" | "anti"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"bi\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "bi" | "anti" as n)), s) + -> + (Ast.BiAnt (_loc, + mk_anti ~c: "binding" n s) : + 'field_expr) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'field_expr) _ (b1 : 'field_expr) + (_loc : Loc.t) -> + (Ast.BiSem (_loc, b1, b2) : 'field_expr)))) ]) ])) + ()); + Gram.extend (meth_list : 'meth_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (field : 'field Gram.Entry.t)); + Gram.Sopt (Gram.Skeyword ";") ], + (Gram.Action.mk + (fun _ (f : 'field) (_loc : Loc.t) -> + (f : 'meth_list)))); + ([ Gram.Snterm + (Gram.Entry.obj (field : 'field Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (ml : 'meth_list) _ (f : 'field) + (_loc : Loc.t) -> + (Ast.TySem (_loc, f, ml) : 'meth_list)))) ]) ])) + ()); + Gram.extend (opt_meth_list : 'opt_meth_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.TyNil _loc : 'opt_meth_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (meth_list : 'meth_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ml : 'meth_list) (_loc : Loc.t) -> + (ml : 'opt_meth_list)))) ]) ])) + ()); + Gram.extend (field : 'field Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (poly_type : 'poly_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'poly_type) _ (lab : 'a_LIDENT) + (_loc : Loc.t) -> + (Ast.TyCol (_loc, + Ast.TyId (_loc, Ast.IdLid (_loc, lab)), t) : + 'field)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, mk_anti ~c: "ctyp" n s) : + 'field) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (poly_type : 'poly_type Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'poly_type)))) ]) ])) + ()); + Gram.extend (typevars : 'typevars Gram.Entry.t) + ((fun () -> + (None, + [ (None, (Some Camlp4.Sig.Grammar.LeftA), + [ ([ Gram.Skeyword "'"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Loc.t) -> + (Ast.TyQuo (_loc, i) : 'typevars)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, mk_anti ~c: "ctyp" n s) : + 'typevars) + | _ -> assert false))); + ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'typevars) (t1 : 'typevars) + (_loc : Loc.t) -> + (Ast.TyApp (_loc, t1, t2) : 'typevars)))) ]) ])) + ()); + Gram.extend (row_field : 'row_field Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'row_field)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)); + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'amp_ctyp) _ (i : 'a_ident) _ + (_loc : Loc.t) -> + (Ast.TyOf (_loc, Ast.TyVrn (_loc, i), t) : + 'row_field)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)); + Gram.Skeyword "of"; Gram.Skeyword "&"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'amp_ctyp) _ _ (i : 'a_ident) _ + (_loc : Loc.t) -> + (Ast.TyOfAmp (_loc, Ast.TyVrn (_loc, i), t) : + 'row_field)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Loc.t) -> + (Ast.TyVrn (_loc, i) : 'row_field)))); + ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'row_field) _ (t1 : 'row_field) + (_loc : Loc.t) -> + (Ast.TyOr (_loc, t1, t2) : 'row_field)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, mk_anti ~c: "ctyp" n s) : + 'row_field) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (sem_ctyp : 'sem_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'sem_ctyp)))); + ([ Gram.Sself; Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'sem_ctyp) _ (t1 : 'sem_ctyp) + (_loc : Loc.t) -> + (Ast.TySem (_loc, t1, t2) : 'sem_ctyp)))) ]) ])) + ()); + Gram.extend (pipe_ctyp : 'pipe_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'pipe_ctyp)))); + ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'pipe_ctyp) _ (t1 : 'pipe_ctyp) + (_loc : Loc.t) -> + (Ast.TyOr (_loc, t1, t2) : 'pipe_ctyp)))) ]) ])) + ()); + Gram.extend (amp_ctyp : 'amp_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) (_loc : Loc.t) -> + (t : 'amp_ctyp)))); + ([ Gram.Sself; Gram.Skeyword "&"; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'amp_ctyp) _ (t1 : 'amp_ctyp) + (_loc : Loc.t) -> + (Ast.TyAmp (_loc, t1, t2) : 'amp_ctyp)))) ]) ])) + ()); + Gram.extend (name_tags : 'name_tags Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_ident : 'a_ident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_ident) _ (_loc : Loc.t) -> + (Ast.TyVrn (_loc, i) : 'name_tags)))); + ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (t2 : 'name_tags) (t1 : 'name_tags) + (_loc : Loc.t) -> + (Ast.TyApp (_loc, t1, t2) : 'name_tags)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "typ"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"typ\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "typ" as n)), s) -> + (Ast.TyAnt (_loc, mk_anti ~c: "ctyp" n s) : + 'name_tags) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (eq_expr : 'eq_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (fun i p -> Ast.PaOlb (_loc, i, p) : + 'eq_expr)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (fun i p -> Ast.PaOlbi (_loc, i, p, e) : + 'eq_expr)))) ]) ])) + ()); + Gram.extend (patt_tcon : 'patt_tcon Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Loc.t) -> + (p : 'patt_tcon)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (p : 'patt) (_loc : Loc.t) -> + (Ast.PaTyc (_loc, p, t) : 'patt_tcon)))) ]) ])) + ()); + Gram.extend (ipatt : 'ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ (* | i = opt_label; "("; p = ipatt_tcon; ")" -> + <:patt< ? $i$ : ($p$) >> + | i = opt_label; "("; p = ipatt_tcon; "="; e = expr; ")" -> + <:patt< ? $i$ : ($p$ = $e$) >> *) + Gram.Skeyword "?"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'expr) _ (p : 'ipatt_tcon) _ _ + (_loc : Loc.t) -> + (Ast.PaOlbi (_loc, "", p, e) : 'ipatt)))); + ([ Gram.Skeyword "?"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'ipatt_tcon) _ _ (_loc : Loc.t) -> + (Ast.PaOlb (_loc, "", p) : 'ipatt)))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaOlb (_loc, mk_anti n i, + Ast.PaNil _loc) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | LIDENT i -> + (Ast.PaOlb (_loc, i, Ast.PaNil _loc) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")); + Gram.Skeyword ":"; Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (eq_expr : 'eq_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (f : 'eq_expr) (p : 'ipatt_tcon) _ _ + (__camlp4_0 : Gram.Token.t) _ (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (f (mk_anti n i) p : 'ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function | OPTLABEL _ -> true | _ -> false), + "OPTLABEL _")); + Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj + (ipatt_tcon : 'ipatt_tcon Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (eq_expr : 'eq_expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (f : 'eq_expr) (p : 'ipatt_tcon) _ + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | OPTLABEL i -> (f i p : 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | LIDENT i -> + (Ast.PaLab (_loc, i, Ast.PaNil _loc) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaLab (_loc, mk_anti n i, + Ast.PaNil _loc) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")); + Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (p : 'ipatt) _ (__camlp4_0 : Gram.Token.t) + _ (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), i) -> + (Ast.PaLab (_loc, mk_anti n i, p) : + 'ipatt) + | _ -> assert false))); + ([ Gram.Stoken + (((function | LABEL _ -> true | _ -> false), + "LABEL _")); + Gram.Sself ], + (Gram.Action.mk + (fun (p : 'ipatt) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | LABEL i -> + (Ast.PaLab (_loc, i, p) : 'ipatt) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (ipatt_tcon : 'ipatt_tcon Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'ipatt) (_loc : Loc.t) -> + (p : 'ipatt_tcon)))); + ([ Gram.Snterm + (Gram.Entry.obj (ipatt : 'ipatt Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'ctyp) _ (p : 'ipatt) (_loc : Loc.t) + -> (Ast.PaTyc (_loc, p, t) : 'ipatt_tcon)))) ]) ])) + ()); + Gram.extend (direction_flag : 'direction_flag Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | ANTIQUOT ("to", _) -> true + | _ -> false), + "ANTIQUOT (\"to\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("to" as n)), s) -> + (Ast.BAnt (mk_anti n s) : + 'direction_flag) + | _ -> assert false))); + ([ Gram.Skeyword "downto" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.BFalse : 'direction_flag)))); + ([ Gram.Skeyword "to" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.BTrue : 'direction_flag)))) ]) ])) + ()); + Gram.extend (opt_private : 'opt_private Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.BFalse : 'opt_private)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("private", _) -> true + | _ -> false), + "ANTIQUOT (\"private\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("private" as n)), s) -> + (Ast.BAnt (mk_anti n s) : 'opt_private) + | _ -> assert false))); + ([ Gram.Skeyword "private" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.BTrue : 'opt_private)))) ]) ])) + ()); + Gram.extend (opt_mutable : 'opt_mutable Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.BFalse : 'opt_mutable)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("mutable", _) -> true + | _ -> false), + "ANTIQUOT (\"mutable\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("mutable" as n)), s) -> + (Ast.BAnt (mk_anti n s) : 'opt_mutable) + | _ -> assert false))); + ([ Gram.Skeyword "mutable" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.BTrue : 'opt_mutable)))) ]) ])) + ()); + Gram.extend (opt_virtual : 'opt_virtual Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.BFalse : 'opt_virtual)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("virtual", _) -> true + | _ -> false), + "ANTIQUOT (\"virtual\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("virtual" as n)), s) -> + (Ast.BAnt (mk_anti n s) : 'opt_virtual) + | _ -> assert false))); + ([ Gram.Skeyword "virtual" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.BTrue : 'opt_virtual)))) ]) ])) + ()); + Gram.extend (opt_dot_dot : 'opt_dot_dot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.BFalse : 'opt_dot_dot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("..", _) -> true + | _ -> false), + "ANTIQUOT (\"..\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT (((".." as n)), s) -> + (Ast.BAnt (mk_anti n s) : 'opt_dot_dot) + | _ -> assert false))); + ([ Gram.Skeyword ".." ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.BTrue : 'opt_dot_dot)))) ]) ])) + ()); + Gram.extend (opt_rec : 'opt_rec Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> (Ast.BFalse : 'opt_rec)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("rec", _) -> true + | _ -> false), + "ANTIQUOT (\"rec\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("rec" as n)), s) -> + (Ast.BAnt (mk_anti n s) : 'opt_rec) + | _ -> assert false))); + ([ Gram.Skeyword "rec" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (Ast.BTrue : 'opt_rec)))) ]) ])) + ()); + Gram.extend (opt_expr : 'opt_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.ExNil _loc : 'opt_expr)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Loc.t) -> + (e : 'opt_expr)))) ]) ])) + ()); + Gram.extend (interf : 'interf Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | EOI -> (([], None) : 'interf) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (sig_item : 'sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun ((sil, stopped) : 'interf) _ + (si : 'sig_item) (_loc : Loc.t) -> + (((si :: sil), stopped) : 'interf)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Loc.t) -> + (([ Ast.SgDir (_loc, n, dp) ], + (stopped_at _loc)) : 'interf)))) ]) ])) + ()); + Gram.extend (sig_items : 'sig_items Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0 + (Gram.srules sig_items + [ ([ Gram.Snterm + (Gram.Entry.obj + (sig_item : + 'sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (sg : 'sig_item) (_loc : Loc.t) + -> (sg : 'e__4)))) ]) ], + (Gram.Action.mk + (fun (l : 'e__4 list) (_loc : Loc.t) -> + (Ast.sgSem_of_list l : 'sig_items)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "sigi" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"sigi\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "sigi" | "anti" | "list" as n)), + s) -> + (Ast.SgAnt (_loc, + mk_anti n ~c: "sig_item" s) : + 'sig_items) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (implem : 'implem Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | EOI -> (([], None) : 'implem) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun ((sil, stopped) : 'implem) _ + (si : 'str_item) (_loc : Loc.t) -> + (((si :: sil), stopped) : 'implem)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Loc.t) -> + (([ Ast.StDir (_loc, n, dp) ], + (stopped_at _loc)) : 'implem)))) ]) ])) + ()); + Gram.extend (str_items : 'str_items Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0 + (Gram.srules str_items + [ ([ Gram.Snterm + (Gram.Entry.obj + (str_item : + 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (st : 'str_item) (_loc : Loc.t) + -> (st : 'e__5)))) ]) ], + (Gram.Action.mk + (fun (l : 'e__5 list) (_loc : Loc.t) -> + (Ast.stSem_of_list l : 'str_items)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "stri" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"stri\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "stri" | "anti" | "list" as n)), + s) -> + (Ast.StAnt (_loc, + mk_anti n ~c: "str_item" s) : + 'str_items) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (top_phrase : 'top_phrase Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | EOI -> (None : 'top_phrase) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj (phrase : 'phrase Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ph : 'phrase) (_loc : Loc.t) -> + (Some ph : 'top_phrase)))) ]) ])) + ()); + Gram.extend (use_file : 'use_file Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | EOI -> true | _ -> false), "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | EOI -> (([], None) : 'use_file) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun ((sil, stopped) : 'use_file) _ + (si : 'str_item) (_loc : Loc.t) -> + (((si :: sil), stopped) : 'use_file)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Loc.t) -> + (([ Ast.StDir (_loc, n, dp) ], + (stopped_at _loc)) : 'use_file)))) ]) ])) + ()); + Gram.extend (phrase : 'phrase Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (st : 'str_item) (_loc : Loc.t) -> + (st : 'phrase)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Loc.t) -> + (Ast.StDir (_loc, n, dp) : 'phrase)))) ]) ])) + ()); + Gram.extend (a_INT : 'a_INT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | INT (_, _) -> true | _ -> false), + "INT (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | INT (_, s) -> (s : 'a_INT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "int" | "`int"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"int\" | \"`int\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "int" | "`int" as n)), s) + -> (mk_anti n s : 'a_INT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_INT32 : 'a_INT32 Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | INT32 (_, _) -> true | _ -> false), + "INT32 (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | INT32 (_, s) -> (s : 'a_INT32) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "int32" | "`int32"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"int32\" | \"`int32\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "int32" | "`int32" as n)), + s) -> (mk_anti n s : 'a_INT32) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_INT64 : 'a_INT64 Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | INT64 (_, _) -> true | _ -> false), + "INT64 (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | INT64 (_, s) -> (s : 'a_INT64) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "int64" | "`int64"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"int64\" | \"`int64\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "int64" | "`int64" as n)), + s) -> (mk_anti n s : 'a_INT64) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_NATIVEINT : 'a_NATIVEINT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | NATIVEINT (_, _) -> true + | _ -> false), + "NATIVEINT (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | NATIVEINT (_, s) -> (s : 'a_NATIVEINT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT + (("" | "nativeint" | "`nativeint"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"nativeint\" | \"`nativeint\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "nativeint" | "`nativeint" as n)), + s) -> (mk_anti n s : 'a_NATIVEINT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_FLOAT : 'a_FLOAT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | FLOAT (_, _) -> true | _ -> false), + "FLOAT (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | FLOAT (_, s) -> (s : 'a_FLOAT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "flo" | "`flo"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"flo\" | \"`flo\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "flo" | "`flo" as n)), s) + -> (mk_anti n s : 'a_FLOAT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_CHAR : 'a_CHAR Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | CHAR (_, _) -> true | _ -> false), + "CHAR (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | CHAR (_, s) -> (s : 'a_CHAR) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "chr" | "`chr"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"chr\" | \"`chr\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "chr" | "`chr" as n)), s) + -> (mk_anti n s : 'a_CHAR) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_UIDENT : 'a_UIDENT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | UIDENT _ -> true | _ -> false), + "UIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | UIDENT s -> (s : 'a_UIDENT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "uid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"uid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "uid" as n)), s) -> + (mk_anti n s : 'a_UIDENT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_LIDENT : 'a_LIDENT Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | LIDENT _ -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | LIDENT s -> (s : 'a_LIDENT) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "lid"), _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"lid\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "lid" as n)), s) -> + (mk_anti n s : 'a_LIDENT) + | _ -> assert false))) ]) ])) + ()); + Gram.extend + (a_LIDENT_or_operator : 'a_LIDENT_or_operator Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'a_LIDENT) (_loc : Loc.t) -> + (x : 'a_LIDENT_or_operator)))) ]) ])) + ()); + Gram.extend (a_LABEL : 'a_LABEL Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | LABEL _ -> true | _ -> false), + "LABEL _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | LABEL s -> (s : 'a_LABEL) + | _ -> assert false))); + ([ Gram.Skeyword "~"; + Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":" ], + (Gram.Action.mk + (fun _ (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), s) -> + (mk_anti n s : 'a_LABEL) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_OPTLABEL : 'a_OPTLABEL Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | OPTLABEL _ -> true | _ -> false), + "OPTLABEL _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | OPTLABEL s -> (s : 'a_OPTLABEL) + | _ -> assert false))); + ([ Gram.Skeyword "?"; + Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":" ], + (Gram.Action.mk + (fun _ (__camlp4_0 : Gram.Token.t) _ + (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), s) -> + (mk_anti n s : 'a_OPTLABEL) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (a_STRING : 'a_STRING Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | STRING (_, _) -> true + | _ -> false), + "STRING (_, _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | STRING (_, s) -> (s : 'a_STRING) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "str" | "`str"), _) -> + true + | _ -> false), + "ANTIQUOT ((\"\" | \"str\" | \"`str\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" | "str" | "`str" as n)), s) + -> (mk_anti n s : 'a_STRING) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (value_let : 'value_let Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "value" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'value_let)))) ]) ])) + ()); + Gram.extend (value_val : 'value_val Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "value" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'value_val)))) ]) ])) + ()); + Gram.extend (semi : 'semi Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'semi)))) ]) ])) + ()); + Gram.extend (expr_quot : 'expr_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.ExNil _loc : 'expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Loc.t) -> + (e : 'expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (sem_expr : 'sem_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e2 : 'sem_expr) _ (e1 : 'expr) + (_loc : Loc.t) -> + (Ast.ExSem (_loc, e1, e2) : 'expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_expr : 'comma_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e2 : 'comma_expr) _ (e1 : 'expr) + (_loc : Loc.t) -> + (Ast.ExCom (_loc, e1, e2) : 'expr_quot)))) ]) ])) + ()); + Gram.extend (patt_quot : 'patt_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.PaNil _loc : 'patt_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'patt) (_loc : Loc.t) -> + (x : 'patt_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'patt) _ (x : 'patt) (_loc : Loc.t) -> + (Ast.PaEq (_loc, x, y) : 'patt_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (sem_patt : 'sem_patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'sem_patt) _ (x : 'patt) + (_loc : Loc.t) -> + (Ast.PaSem (_loc, x, y) : 'patt_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_patt : 'comma_patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'comma_patt) _ (x : 'patt) + (_loc : Loc.t) -> + (Ast.PaCom (_loc, x, y) : 'patt_quot)))) ]) ])) + ()); + Gram.extend (ctyp_quot : 'ctyp_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.TyNil _loc : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'more_ctyp) (_loc : Loc.t) -> + (x : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "and"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'constructor_arg_list) _ + (x : 'more_ctyp) (_loc : Loc.t) -> + (Ast.TyAnd (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "&"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'amp_ctyp) _ (x : 'more_ctyp) + (_loc : Loc.t) -> + (Ast.TyAmp (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "*"; + Gram.Snterm + (Gram.Entry.obj + (star_ctyp : 'star_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'star_ctyp) _ (x : 'more_ctyp) + (_loc : Loc.t) -> + (Ast.TySta (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'more_ctyp) _ (x : 'more_ctyp) + (_loc : Loc.t) -> + (Ast.TyCol (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "of"; Gram.Skeyword "&"; + Gram.Snterm + (Gram.Entry.obj + (amp_ctyp : 'amp_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'amp_ctyp) _ _ (x : 'more_ctyp) + (_loc : Loc.t) -> + (Ast.TyOfAmp (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "of"; + Gram.Snterm + (Gram.Entry.obj + (constructor_arg_list : + 'constructor_arg_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'constructor_arg_list) _ + (x : 'more_ctyp) (_loc : Loc.t) -> + (Ast.TyOf (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword "|"; + Gram.Snterm + (Gram.Entry.obj + (pipe_ctyp : 'pipe_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'pipe_ctyp) _ (x : 'more_ctyp) + (_loc : Loc.t) -> + (Ast.TyOr (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (sem_ctyp : 'sem_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'sem_ctyp) _ (x : 'more_ctyp) + (_loc : Loc.t) -> + (Ast.TySem (_loc, x, y) : 'ctyp_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (more_ctyp : 'more_ctyp Gram.Entry.t)); + Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_ctyp : 'comma_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (y : 'comma_ctyp) _ (x : 'more_ctyp) + (_loc : Loc.t) -> + (Ast.TyCom (_loc, x, y) : 'ctyp_quot)))) ]) ])) + ()); + Gram.extend (more_ctyp : 'more_ctyp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (type_parameter : + 'type_parameter Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'type_parameter) (_loc : Loc.t) -> + (x : 'more_ctyp)))); + ([ Gram.Snterm + (Gram.Entry.obj (ctyp : 'ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'ctyp) (_loc : Loc.t) -> + (x : 'more_ctyp)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'a_LIDENT) _ (_loc : Loc.t) -> + (Ast.TyVrn (_loc, x) : 'more_ctyp)))); + ([ Gram.Skeyword "mutable"; Gram.Sself ], + (Gram.Action.mk + (fun (x : 'more_ctyp) _ (_loc : Loc.t) -> + (Ast.TyMut (_loc, x) : 'more_ctyp)))) ]) ])) + ()); + Gram.extend (str_item_quot : 'str_item_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.StNil _loc : 'str_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)) ], + (Gram.Action.mk + (fun (st : 'str_item) (_loc : Loc.t) -> + (st : 'str_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (str_item : 'str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (st2 : 'str_item_quot) _ (st1 : 'str_item) + (_loc : Loc.t) -> + (Ast.StSem (_loc, st1, st2) : 'str_item_quot)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Loc.t) -> + (Ast.StDir (_loc, n, dp) : 'str_item_quot)))) ]) ])) + ()); + Gram.extend (sig_item_quot : 'sig_item_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.SgNil _loc : 'sig_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (sig_item : 'sig_item Gram.Entry.t)) ], + (Gram.Action.mk + (fun (sg : 'sig_item) (_loc : Loc.t) -> + (sg : 'sig_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (sig_item : 'sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (sg2 : 'sig_item_quot) _ (sg1 : 'sig_item) + (_loc : Loc.t) -> + (Ast.SgSem (_loc, sg1, sg2) : 'sig_item_quot)))); + ([ Gram.Skeyword "#"; + Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_expr : 'opt_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (dp : 'opt_expr) (n : 'a_LIDENT) _ + (_loc : Loc.t) -> + (Ast.SgDir (_loc, n, dp) : 'sig_item_quot)))) ]) ])) + ()); + Gram.extend (module_type_quot : 'module_type_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'module_type) (_loc : Loc.t) -> + (x : 'module_type_quot)))) ]) ])) + ()); + Gram.extend (module_expr_quot : 'module_expr_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'module_expr) (_loc : Loc.t) -> + (x : 'module_expr_quot)))) ]) ])) + ()); + Gram.extend (match_case_quot : 'match_case_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.McNil _loc : 'match_case_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (match_case : 'match_case Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'match_case) (_loc : Loc.t) -> + (x : 'match_case_quot)))) ]) ])) + ()); + Gram.extend (binding_quot : 'binding_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.BiNil _loc : 'binding_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (label_expr : 'label_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'label_expr) (_loc : Loc.t) -> + (x : 'binding_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (binding : 'binding Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'binding) (_loc : Loc.t) -> + (x : 'binding_quot)))); + ([ Gram.Sself; Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'binding_quot) _ (b1 : 'binding_quot) + (_loc : Loc.t) -> + (Ast.BiSem (_loc, b1, b2) : 'binding_quot)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'binding_quot) _ (b1 : 'binding_quot) + (_loc : Loc.t) -> + (Ast.BiAnd (_loc, b1, b2) : 'binding_quot)))) ]) ])) + ()); + Gram.extend + (module_binding_quot : 'module_binding_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.MbNil _loc : 'module_binding_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) _ + (m : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.MbColEq (_loc, m, mt, me) : + 'module_binding_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ (m : 'a_UIDENT) + (_loc : Loc.t) -> + (Ast.MbCol (_loc, m, mt) : + 'module_binding_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (module_expr : 'module_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (me : 'module_expr) _ (mt : 'module_type) _ + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), m) -> + (Ast.MbColEq (_loc, mk_anti n m, mt, me) : + 'module_binding_quot) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (module_type : 'module_type Gram.Entry.t)) ], + (Gram.Action.mk + (fun (mt : 'module_type) _ + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), m) -> + (Ast.MbCol (_loc, mk_anti n m, mt) : + 'module_binding_quot) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ((("" as n)), s) -> + (Ast.MbAnt (_loc, + mk_anti ~c: "module_binding" n s) : + 'module_binding_quot) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("module_binding" | "anti"), _) + -> true + | _ -> false), + "ANTIQUOT ((\"module_binding\" | \"anti\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("module_binding" | "anti" as n)), s) + -> + (Ast.MbAnt (_loc, + mk_anti ~c: "module_binding" n s) : + 'module_binding_quot) + | _ -> assert false))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (b2 : 'module_binding_quot) _ + (b1 : 'module_binding_quot) (_loc : Loc.t) -> + (Ast.MbAnd (_loc, b1, b2) : + 'module_binding_quot)))) ]) ])) + ()); + Gram.extend (ident_quot : 'ident_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Sself; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'ident_quot) (i : 'ident_quot) + (_loc : Loc.t) -> + (Ast.IdApp (_loc, i, j) : 'ident_quot)))) ]); + (None, None, + [ ([ Gram.Sself; Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (j : 'ident_quot) _ (i : 'ident_quot) + (_loc : Loc.t) -> + (Ast.IdAcc (_loc, i, j) : 'ident_quot)))) ]); + (None, None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (i : 'ident_quot) _ (_loc : Loc.t) -> + (i : 'ident_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (i : 'ident_quot) _ + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), s) + -> + (Ast.IdAcc (_loc, + Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s), + i) : + 'ident_quot) + | _ -> assert false))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (Ast.IdLid (_loc, i) : 'ident_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_UIDENT : 'a_UIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_UIDENT) (_loc : Loc.t) -> + (Ast.IdUid (_loc, i) : 'ident_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT (("" | "id" | "anti" | "list"), + _) -> true + | _ -> false), + "ANTIQUOT ((\"\" | \"id\" | \"anti\" | \"list\"), _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT + ((("" | "id" | "anti" | "list" as n)), s) + -> + (Ast.IdAnt (_loc, + mk_anti ~c: "ident" n s) : + 'ident_quot) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (class_expr_quot : 'class_expr_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.CeNil _loc : 'class_expr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_expr : 'class_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'class_expr) (_loc : Loc.t) -> + (x : 'class_expr_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("virtual", _) -> true + | _ -> false), + "ANTIQUOT (\"virtual\", _)")); + Gram.Snterm + (Gram.Entry.obj (ident : 'ident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_comma_ctyp : + 'opt_comma_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ot : 'opt_comma_ctyp) (i : 'ident) + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("virtual" as n)), s) -> + (Ast.CeCon (_loc, + Ast.BAnt + (mk_anti ~c: "class_expr" n s), + i, ot) : + 'class_expr_quot) + | _ -> assert false))); + ([ Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (class_name_and_param : + 'class_name_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((i, ot) : 'class_name_and_param) _ + (_loc : Loc.t) -> + (Ast.CeCon (_loc, Ast.BTrue, + Ast.IdLid (_loc, i), ot) : + 'class_expr_quot)))); + ([ Gram.Sself; Gram.Skeyword "="; Gram.Sself ], + (Gram.Action.mk + (fun (ce2 : 'class_expr_quot) _ + (ce1 : 'class_expr_quot) (_loc : Loc.t) -> + (Ast.CeEq (_loc, ce1, ce2) : + 'class_expr_quot)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (ce2 : 'class_expr_quot) _ + (ce1 : 'class_expr_quot) (_loc : Loc.t) -> + (Ast.CeAnd (_loc, ce1, ce2) : + 'class_expr_quot)))) ]) ])) + ()); + Gram.extend (class_type_quot : 'class_type_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.CtNil _loc : 'class_type_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_type_plus : + 'class_type_plus Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'class_type_plus) (_loc : Loc.t) -> + (x : 'class_type_quot)))); + ([ Gram.Stoken + (((function + | ANTIQUOT ("virtual", _) -> true + | _ -> false), + "ANTIQUOT (\"virtual\", _)")); + Gram.Snterm + (Gram.Entry.obj (ident : 'ident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_comma_ctyp : + 'opt_comma_ctyp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ot : 'opt_comma_ctyp) (i : 'ident) + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ((("virtual" as n)), s) -> + (Ast.CtCon (_loc, + Ast.BAnt + (mk_anti ~c: "class_type" n s), + i, ot) : + 'class_type_quot) + | _ -> assert false))); + ([ Gram.Skeyword "virtual"; + Gram.Snterm + (Gram.Entry.obj + (class_name_and_param : + 'class_name_and_param Gram.Entry.t)) ], + (Gram.Action.mk + (fun ((i, ot) : 'class_name_and_param) _ + (_loc : Loc.t) -> + (Ast.CtCon (_loc, Ast.BTrue, + Ast.IdLid (_loc, i), ot) : + 'class_type_quot)))); + ([ Gram.Sself; Gram.Skeyword ":"; Gram.Sself ], + (Gram.Action.mk + (fun (ct2 : 'class_type_quot) _ + (ct1 : 'class_type_quot) (_loc : Loc.t) -> + (Ast.CtCol (_loc, ct1, ct2) : + 'class_type_quot)))); + ([ Gram.Sself; Gram.Skeyword "="; Gram.Sself ], + (Gram.Action.mk + (fun (ct2 : 'class_type_quot) _ + (ct1 : 'class_type_quot) (_loc : Loc.t) -> + (Ast.CtEq (_loc, ct1, ct2) : + 'class_type_quot)))); + ([ Gram.Sself; Gram.Skeyword "and"; Gram.Sself ], + (Gram.Action.mk + (fun (ct2 : 'class_type_quot) _ + (ct1 : 'class_type_quot) (_loc : Loc.t) -> + (Ast.CtAnd (_loc, ct1, ct2) : + 'class_type_quot)))) ]) ])) + ()); + Gram.extend + (class_str_item_quot : 'class_str_item_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.CrNil _loc : 'class_str_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_str_item : + 'class_str_item Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'class_str_item) (_loc : Loc.t) -> + (x : 'class_str_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_str_item : + 'class_str_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (x2 : 'class_str_item_quot) _ + (x1 : 'class_str_item) (_loc : Loc.t) -> + (Ast.CrSem (_loc, x1, x2) : + 'class_str_item_quot)))) ]) ])) + ()); + Gram.extend + (class_sig_item_quot : 'class_sig_item_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.CgNil _loc : 'class_sig_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_sig_item : + 'class_sig_item Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'class_sig_item) (_loc : Loc.t) -> + (x : 'class_sig_item_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (class_sig_item : + 'class_sig_item Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (semi : 'semi Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (x2 : 'class_sig_item_quot) _ + (x1 : 'class_sig_item) (_loc : Loc.t) -> + (Ast.CgSem (_loc, x1, x2) : + 'class_sig_item_quot)))) ]) ])) + ()); + Gram.extend (with_constr_quot : 'with_constr_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> + (Ast.WcNil _loc : 'with_constr_quot)))); + ([ Gram.Snterm + (Gram.Entry.obj + (with_constr : 'with_constr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'with_constr) (_loc : Loc.t) -> + (x : 'with_constr_quot)))) ]) ])) + ()); + Gram.extend (patt_eoi : 'patt_eoi Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Stoken + (((function | EOI -> true | _ -> false), "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (x : 'patt) + (_loc : Loc.t) -> + match __camlp4_0 with + | EOI -> (x : 'patt_eoi) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (expr_eoi : 'expr_eoi Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Stoken + (((function | EOI -> true | _ -> false), "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (x : 'expr) + (_loc : Loc.t) -> + match __camlp4_0 with + | EOI -> (x : 'expr_eoi) + | _ -> assert false))) ]) ])) + ())) + end + let _ = let module M = Register.OCamlSyntaxExtension(Id)(Make) in () + end +module Camlp4QuotationCommon = + struct + open Camlp4 + (* -*- camlp4r -*- *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Nicolas Pouillard: initial version + *) + module Id = + struct + let name = "Camlp4QuotationCommon" + let version = + "$Id: OCamlQuotationBase.ml,v 1.7 2006/10/04 16:22:54 ertai Exp $" + end + module Make + (Syntax : Sig.Camlp4Syntax) + (TheAntiquotSyntax : + Sig.AntiquotSyntax with module Ast = Sig.Camlp4AstToAst(Syntax.Ast)) = + struct + open Sig + include Syntax + (* Be careful an AntiquotSyntax module appears here *) + module MetaLocHere = Ast.Meta.MetaLoc + module MetaLoc = + struct + module Ast = Ast + let loc_name = ref None + let meta_loc_expr _loc loc = + match !loc_name with + | None -> Ast.ExId (_loc, Ast.IdLid (_loc, !Loc.name)) + | Some "here" -> MetaLocHere.meta_loc_expr _loc loc + | Some x -> Ast.ExId (_loc, Ast.IdLid (_loc, x)) + let meta_loc_patt _loc _ = Ast.PaAny _loc + end + module MetaAst = Ast.Meta.Make(MetaLoc) + module ME = MetaAst.Expr + module MP = MetaAst.Patt + let is_antiquot s = + let len = String.length s + in (len > 2) && ((s.[0] = '\\') && (s.[1] = '$')) + let handle_antiquot_in_string s term parse loc decorate = + if is_antiquot s + then + (let pos = String.index s ':' in + let name = String.sub s 2 (pos - 2) + and code = + String.sub s (pos + 1) (((String.length s) - pos) - 1) + in decorate name (parse loc code)) + else term + let antiquot_expander = + object + inherit Ast.map as super + method patt = + function + | (Ast.PaAnt (_loc, s) | Ast.PaStr (_loc, s) as p) -> + let mloc _loc = MetaLoc.meta_loc_patt _loc _loc + in + handle_antiquot_in_string s p TheAntiquotSyntax. + parse_patt _loc + (fun n p -> + match n with + | "antisig_item" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgAnt"))), + mloc _loc), + p) + | "antistr_item" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StAnt"))), + mloc _loc), + p) + | "antictyp" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAnt"))), + mloc _loc), + p) + | "antipatt" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaAnt"))), + mloc _loc), + p) + | "antiexpr" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAnt"))), + mloc _loc), + p) + | "antimodule_type" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtAnt"))), + mloc _loc), + p) + | "antimodule_expr" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeAnt"))), + mloc _loc), + p) + | "anticlass_type" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtAnt"))), + mloc _loc), + p) + | "anticlass_expr" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeAnt"))), + mloc _loc), + p) + | "anticlass_sig_item" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgAnt"))), + mloc _loc), + p) + | "anticlass_str_item" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrAnt"))), + mloc _loc), + p) + | "antiwith_constr" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcAnt"))), + mloc _loc), + p) + | "antibinding" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiAnt"))), + mloc _loc), + p) + | "antimatch_case" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "McAnt"))), + mloc _loc), + p) + | "antimodule_binding" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbAnt"))), + mloc _loc), + p) + | "antiident" -> + Ast.PaApp (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdAnt"))), + mloc _loc), + p) + | _ -> p) + | p -> super#patt p + method expr = + function + | (Ast.ExAnt (_loc, s) | Ast.ExStr (_loc, s) as e) -> + let mloc _loc = MetaLoc.meta_loc_expr _loc _loc + in + handle_antiquot_in_string s e TheAntiquotSyntax. + parse_expr _loc + (fun n e -> + match n with + | "`int" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdLid (_loc, "string_of_int")), + e) + | "`int32" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Int32"), + Ast.IdLid (_loc, "to_string"))), + e) + | "`int64" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Int64"), + Ast.IdLid (_loc, "to_string"))), + e) + | "`nativeint" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Nativeint"), + Ast.IdLid (_loc, "to_string"))), + e) + | "`flo" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdLid (_loc, "string_of_float")), + e) + | "`str" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "safe_string_escaped"))), + e) + | "`chr" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Char"), + Ast.IdLid (_loc, "escaped"))), + e) + | "liststr_item" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "stSem_of_list"))), + e) + | "listsig_item" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "sgSem_of_list"))), + e) + | "listclass_sig_item" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "cgSem_of_list"))), + e) + | "listclass_str_item" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "crSem_of_list"))), + e) + | "listmodule_expr" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "meApp_of_list"))), + e) + | "listmodule_type" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "mtApp_of_list"))), + e) + | "listmodule_binding" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "mbAnd_of_list"))), + e) + | "listbinding" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "biAnd_of_list"))), + e) + | "listbinding;" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "biSem_of_list"))), + e) + | "listclass_type" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "ctAnd_of_list"))), + e) + | "listclass_expr" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "ceAnd_of_list"))), + e) + | "listident" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "idAcc_of_list"))), + e) + | "listctypand" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "tyAnd_of_list"))), + e) + | "listwith_constr" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "wcAnd_of_list"))), + e) + | "listmatch_case" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "mcOr_of_list"))), + e) + | "listpatt;" -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdLid (_loc, "paSem_of_list"))), + e) + | "antisig_item" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "SgAnt"))), + mloc _loc), + e) + | "antistr_item" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "StAnt"))), + mloc _loc), + e) + | "antictyp" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "TyAnt"))), + mloc _loc), + e) + | "antipatt" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "PaAnt"))), + mloc _loc), + e) + | "antiexpr" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "ExAnt"))), + mloc _loc), + e) + | "antimodule_type" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MtAnt"))), + mloc _loc), + e) + | "antimodule_expr" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MeAnt"))), + mloc _loc), + e) + | "anticlass_type" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CtAnt"))), + mloc _loc), + e) + | "anticlass_expr" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CeAnt"))), + mloc _loc), + e) + | "anticlass_sig_item" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CgAnt"))), + mloc _loc), + e) + | "anticlass_str_item" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "CrAnt"))), + mloc _loc), + e) + | "antiwith_constr" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "WcAnt"))), + mloc _loc), + e) + | "antibinding" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "BiAnt"))), + mloc _loc), + e) + | "antimatch_case" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "McAnt"))), + mloc _loc), + e) + | "antimodule_binding" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "MbAnt"))), + mloc _loc), + e) + | "antiident" -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, "IdAnt"))), + mloc _loc), + e) + | _ -> e) + | e -> super#expr e + end + let add_quotation name entry mexpr mpatt = + let entry_eoi = Gram.Entry.mk (Gram.Entry.name entry) in + let expand_expr loc loc_name_opt s = + let ast = Gram.parse_string entry_eoi loc s in + let () = MetaLoc.loc_name := loc_name_opt in + let meta_ast = mexpr loc ast in + let exp_ast = antiquot_expander#expr meta_ast in exp_ast in + let expand_patt _loc loc_name_opt s = + let ast = Gram.parse_string entry_eoi _loc s in + let meta_ast = mpatt _loc ast in + let exp_ast = antiquot_expander#patt meta_ast + in + match loc_name_opt with + | None -> exp_ast + | Some name -> + let rec subst_first_loc = + (function + | Ast.PaApp (_loc, + (Ast.PaId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Ast")), + (Ast.IdUid (_, u)))))), + _) -> + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Ast"), + Ast.IdUid (_loc, u))), + Ast.PaId (_loc, Ast.IdLid (_loc, name))) + | Ast.PaApp (_loc, a, b) -> + Ast.PaApp (_loc, subst_first_loc a, b) + | p -> p) + in subst_first_loc exp_ast + in + (Gram.extend (entry_eoi : 'entry_eoi Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (entry : 'entry Gram.Entry.t)); + Gram.Stoken + (((function | EOI -> true | _ -> false), "EOI")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (x : 'entry) + (_loc : Loc.t) -> + match __camlp4_0 with + | EOI -> (x : 'entry_eoi) + | _ -> assert false))) ]) ])) + ()); + Quotation.add name + (Quotation.ExAst ((expand_expr, expand_patt)))) + let _ = + add_quotation "sig_item" sig_item_quot ME.meta_sig_item MP. + meta_sig_item + let _ = + add_quotation "str_item" str_item_quot ME.meta_str_item MP. + meta_str_item + let _ = add_quotation "ctyp" ctyp_quot ME.meta_ctyp MP.meta_ctyp + let _ = add_quotation "patt" patt_quot ME.meta_patt MP.meta_patt + let _ = add_quotation "expr" expr_quot ME.meta_expr MP.meta_expr + let _ = + add_quotation "module_type" module_type_quot ME.meta_module_type + MP.meta_module_type + let _ = + add_quotation "module_expr" module_expr_quot ME.meta_module_expr + MP.meta_module_expr + let _ = + add_quotation "class_type" class_type_quot ME.meta_class_type MP. + meta_class_type + let _ = + add_quotation "class_expr" class_expr_quot ME.meta_class_expr MP. + meta_class_expr + let _ = + add_quotation "class_sig_item" class_sig_item_quot ME. + meta_class_sig_item MP.meta_class_sig_item + let _ = + add_quotation "class_str_item" class_str_item_quot ME. + meta_class_str_item MP.meta_class_str_item + let _ = + add_quotation "with_constr" with_constr_quot ME.meta_with_constr + MP.meta_with_constr + let _ = + add_quotation "binding" binding_quot ME.meta_binding MP. + meta_binding + let _ = + add_quotation "match_case" match_case_quot ME.meta_match_case MP. + meta_match_case + let _ = + add_quotation "module_binding" module_binding_quot ME. + meta_module_binding MP.meta_module_binding + let _ = add_quotation "ident" ident_quot ME.meta_ident MP.meta_ident + end + end +module Q = + struct + open Camlp4 + (* -*- camlp4r -*- *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + module Id = + struct + let name = "Camlp4QuotationExpander" + let version = + "$Id: OCamlQuotation.ml,v 1.3 2006/07/08 17:21:32 pouillar Exp $" + end + module Make (Syntax : Sig.Camlp4Syntax) = + struct + module M = Camlp4QuotationCommon.Make(Syntax)(Syntax.AntiquotSyntax) + include M + end + let _ = let module M = Register.OCamlSyntaxExtension(Id)(Make) in () + end +module Rp = + struct + open Camlp4 + (* -*- camlp4r -*- *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 1998-2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + module Id : Sig.Id = + struct + let name = "Camlp4OCamlRevisedParserParser" + let version = + "$Id: OCamlRevisedParser.ml,v 1.5 2006/07/08 18:10:10 pouillar Exp $" + end + module Make (Syntax : Sig.Camlp4Syntax) = + struct + open Sig + include Syntax + type spat_comp = + | SpTrm of Loc.t * Ast.patt * Ast.expr option + | SpNtr of Loc.t * Ast.patt * Ast.expr | SpStr of Loc.t * Ast.patt + type sexp_comp = + | SeTrm of Loc.t * Ast.expr | SeNtr of Loc.t * Ast.expr + let stream_expr = Gram.Entry.mk "stream_expr" + let stream_begin = Gram.Entry.mk "stream_begin" + let stream_end = Gram.Entry.mk "stream_end" + let stream_quot = Gram.Entry.mk "stream_quot" + let parser_case = Gram.Entry.mk "parser_case" + let parser_case_list = Gram.Entry.mk "parser_case_list" + let strm_n = "__strm" + let peek_fun _loc = + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "peek"))) + let junk_fun _loc = + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "junk"))) + (* Parsers. *) + (* In syntax generated, many cases are optimisations. *) + let rec pattern_eq_expression p e = + match (p, e) with + | (Ast.PaId (_, (Ast.IdLid (_, a))), + Ast.ExId (_, (Ast.IdLid (_, b)))) -> a = b + | (Ast.PaId (_, (Ast.IdUid (_, a))), + Ast.ExId (_, (Ast.IdUid (_, b)))) -> a = b + | (Ast.PaApp (_, p1, p2), Ast.ExApp (_, e1, e2)) -> + (pattern_eq_expression p1 e1) && (pattern_eq_expression p2 e2) + | _ -> false + let is_raise e = + match e with + | Ast.ExApp (_, (Ast.ExId (_, (Ast.IdLid (_, "raise")))), _) -> + true + | _ -> false + let is_raise_failure e = + match e with + | Ast.ExApp (_, (Ast.ExId (_, (Ast.IdLid (_, "raise")))), + (Ast.ExId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Stream")), + (Ast.IdUid (_, "Failure"))))))) + -> true + | _ -> false + let rec handle_failure e = + match e with + | Ast.ExTry (_, _, + (Ast.McArr (_, + (Ast.PaId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Stream")), + (Ast.IdUid (_, "Failure")))))), + (Ast.ExNil _), e))) + -> handle_failure e + | Ast.ExMat (_, me, a) -> + let rec match_case_handle_failure = + (function + | Ast.McOr (_, a1, a2) -> + (match_case_handle_failure a1) && + (match_case_handle_failure a2) + | Ast.McArr (_, _, (Ast.ExNil _), e) -> handle_failure e + | _ -> false) + in (handle_failure me) && (match_case_handle_failure a) + | Ast.ExLet (_, Ast.BFalse, bi, e) -> + let rec binding_handle_failure = + (function + | Ast.BiAnd (_, b1, b2) -> + (binding_handle_failure b1) && + (binding_handle_failure b2) + | Ast.BiEq (_, _, e) -> handle_failure e + | _ -> false) + in (binding_handle_failure bi) && (handle_failure e) + | Ast.ExId (_, (Ast.IdLid (_, _))) | Ast.ExInt (_, _) | + Ast.ExStr (_, _) | Ast.ExChr (_, _) | Ast.ExFun (_, _) | + Ast.ExId (_, (Ast.IdUid (_, _))) -> true + | Ast.ExApp (_, (Ast.ExId (_, (Ast.IdLid (_, "raise")))), e) -> + (match e with + | Ast.ExId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Stream")), + (Ast.IdUid (_, "Failure"))))) + -> false + | _ -> true) + | Ast.ExApp (_, f, x) -> + (is_constr_apply f) && + ((handle_failure f) && (handle_failure x)) + | _ -> false + and is_constr_apply = + function + | Ast.ExId (_, (Ast.IdUid (_, _))) -> true + | Ast.ExId (_, (Ast.IdLid (_, _))) -> false + | Ast.ExApp (_, x, _) -> is_constr_apply x + | _ -> false + let rec subst v e = + let _loc = Ast.loc_of_expr e + in + match e with + | Ast.ExId (_, (Ast.IdLid (_, x))) -> + let x = if x = v then strm_n else x + in Ast.ExId (_loc, Ast.IdLid (_loc, x)) + | Ast.ExId (_, (Ast.IdUid (_, _))) -> e + | Ast.ExInt (_, _) -> e + | Ast.ExChr (_, _) -> e + | Ast.ExStr (_, _) -> e + | Ast.ExAcc (_, _, _) -> e + | Ast.ExLet (_, rf, bi, e) -> + Ast.ExLet (_loc, rf, subst_binding v bi, subst v e) + | Ast.ExApp (_, e1, e2) -> + Ast.ExApp (_loc, subst v e1, subst v e2) + | Ast.ExTup (_, e) -> Ast.ExTup (_loc, subst v e) + | Ast.ExCom (_, e1, e2) -> + Ast.ExCom (_loc, subst v e1, subst v e2) + | _ -> raise Not_found + and subst_binding v = + function + | Ast.BiAnd (_loc, b1, b2) -> + Ast.BiAnd (_loc, subst_binding v b1, subst_binding v b2) + | Ast.BiEq (_loc, (Ast.PaId (_, (Ast.IdLid (_, v')))), e) -> + Ast.BiEq (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, v')), + if v = v' then e else subst v e) + | _ -> raise Not_found + let stream_pattern_component skont ckont = + function + | SpTrm (_loc, p, None) -> + Ast.ExMat (_loc, + Ast.ExApp (_loc, peek_fun _loc, + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n))), + Ast.McOr (_loc, + Ast.McArr (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, "Some")), p), + Ast.ExNil _loc, + Ast.ExSeq (_loc, + Ast.ExSem (_loc, + Ast.ExApp (_loc, junk_fun _loc, + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n))), + skont))), + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, ckont))) + | SpTrm (_loc, p, (Some w)) -> + Ast.ExMat (_loc, + Ast.ExApp (_loc, peek_fun _loc, + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n))), + Ast.McOr (_loc, + Ast.McArr (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, "Some")), p), + w, + Ast.ExSeq (_loc, + Ast.ExSem (_loc, + Ast.ExApp (_loc, junk_fun _loc, + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n))), + skont))), + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, ckont))) + | SpNtr (_loc, p, e) -> + let e = + (match e with + | Ast.ExFun (_, + (Ast.McArr (_, + (Ast.PaTyc (_, (Ast.PaId (_, (Ast.IdLid (_, v)))), + (Ast.TyApp (_, + (Ast.TyId (_, + (Ast.IdAcc (_, (Ast.IdUid (_, "Stream")), + (Ast.IdLid (_, "t")))))), + (Ast.TyAny _))))), + (Ast.ExNil _), e))) + when v = strm_n -> e + | _ -> + Ast.ExApp (_loc, e, + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n)))) + in + if pattern_eq_expression p skont + then + if is_raise_failure ckont + then e + else + if handle_failure e + then e + else + Ast.ExTry (_loc, e, + Ast.McArr (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdUid (_loc, "Failure"))), + Ast.ExNil _loc, ckont)) + else + if is_raise_failure ckont + then + Ast.ExLet (_loc, Ast.BFalse, Ast.BiEq (_loc, p, e), + skont) + else + if + pattern_eq_expression + (Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, "Some")), p)) + skont + then + Ast.ExTry (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "Some")), e), + Ast.McArr (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdUid (_loc, "Failure"))), + Ast.ExNil _loc, ckont)) + else + if is_raise ckont + then + (let tst = + if handle_failure e + then e + else + Ast.ExTry (_loc, e, + Ast.McArr (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Stream"), + Ast.IdUid (_loc, "Failure"))), + Ast.ExNil _loc, ckont)) + in + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, p, tst), skont)) + else + Ast.ExMat (_loc, + Ast.ExTry (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "Some")), e), + Ast.McArr (_loc, + Ast.PaId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdUid (_loc, "Failure"))), + Ast.ExNil _loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "None")))), + Ast.McOr (_loc, + Ast.McArr (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, "Some")), p), + Ast.ExNil _loc, skont), + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, + ckont))) + | SpStr (_loc, p) -> + (try + match p with + | Ast.PaId (_, (Ast.IdLid (_, v))) -> subst v skont + | _ -> raise Not_found + with + | Not_found -> + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, p, + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n))), + skont)) + let rec stream_pattern _loc epo e ekont = + function + | [] -> + (match epo with + | Some ep -> + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, ep, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "count"))), + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n)))), + e) + | _ -> e) + | (spc, err) :: spcl -> + let skont = + let ekont err = + let str = + (match err with + | Some estr -> estr + | _ -> Ast.ExStr (_loc, "")) + in + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "raise")), + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdUid (_loc, "Error"))), + str)) + in stream_pattern _loc epo e ekont spcl in + let ckont = ekont err + in stream_pattern_component skont ckont spc + let stream_patterns_term _loc ekont tspel = + let pel = + List.fold_right + (fun (p, w, _loc, spcl, epo, e) acc -> + let p = + Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, "Some")), p) in + let e = + let ekont err = + let str = + match err with + | Some estr -> estr + | _ -> Ast.ExStr (_loc, "") + in + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "raise")), + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdUid (_loc, "Error"))), + str)) in + let skont = stream_pattern _loc epo e ekont spcl + in + Ast.ExSeq (_loc, + Ast.ExSem (_loc, + Ast.ExApp (_loc, junk_fun _loc, + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n))), + skont)) + in + match w with + | Some w -> + Ast.McOr (_loc, Ast.McArr (_loc, p, w, e), acc) + | None -> + Ast.McOr (_loc, + Ast.McArr (_loc, p, Ast.ExNil _loc, e), acc)) + tspel (Ast.McNil _loc) + in + Ast.ExMat (_loc, + Ast.ExApp (_loc, peek_fun _loc, + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n))), + Ast.McOr (_loc, pel, + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, ekont ()))) + let rec group_terms = + function + | ((SpTrm (_loc, p, w), None) :: spcl, epo, e) :: spel -> + let (tspel, spel) = group_terms spel + in (((p, w, _loc, spcl, epo, e) :: tspel), spel) + | spel -> ([], spel) + let rec parser_cases _loc = + function + | [] -> + Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdLid (_loc, "raise")), + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdUid (_loc, "Failure")))) + | spel -> + (match group_terms spel with + | ([], (spcl, epo, e) :: spel) -> + stream_pattern _loc epo e + (fun _ -> parser_cases _loc spel) spcl + | (tspel, spel) -> + stream_patterns_term _loc + (fun _ -> parser_cases _loc spel) tspel) + let cparser _loc bpo pc = + let e = parser_cases _loc pc in + let e = + match bpo with + | Some bp -> + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, bp, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "count"))), + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n)))), + e) + | None -> e in + let p = + Ast.PaTyc (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, strm_n)), + Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "t"))), + Ast.TyAny _loc)) + in Ast.ExFun (_loc, Ast.McArr (_loc, p, Ast.ExNil _loc, e)) + let cparser_match _loc me bpo pc = + let pc = parser_cases _loc pc in + let e = + match bpo with + | Some bp -> + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, bp, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "count"))), + Ast.ExId (_loc, Ast.IdLid (_loc, strm_n)))), + pc) + | None -> pc + in + match me with + | Ast.ExId (_, (Ast.IdLid (_, x))) when x = strm_n -> e + | _ -> + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, + Ast.PaTyc (_loc, + Ast.PaId (_loc, Ast.IdLid (_loc, strm_n)), + Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "t"))), + Ast.TyAny _loc)), + me), + e) + (* streams *) + let rec not_computing = + function + | Ast.ExId (_, (Ast.IdLid (_, _))) | + Ast.ExId (_, (Ast.IdUid (_, _))) | Ast.ExInt (_, _) | + Ast.ExFlo (_, _) | Ast.ExChr (_, _) | Ast.ExStr (_, _) -> true + | Ast.ExApp (_, x, y) -> + (is_cons_apply_not_computing x) && (not_computing y) + | _ -> false + and is_cons_apply_not_computing = + function + | Ast.ExId (_, (Ast.IdUid (_, _))) -> true + | Ast.ExId (_, (Ast.IdLid (_, _))) -> false + | Ast.ExApp (_, x, y) -> + (is_cons_apply_not_computing x) && (not_computing y) + | _ -> false + let slazy _loc e = + match e with + | Ast.ExApp (_, f, (Ast.ExId (_, (Ast.IdUid (_, "()"))))) -> + (match f with + | Ast.ExId (_, (Ast.IdLid (_, _))) -> f + | _ -> + Ast.ExFun (_loc, + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, e))) + | _ -> + Ast.ExFun (_loc, + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, e)) + let rec cstream gloc = + function + | [] -> + let _loc = gloc + in + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "sempty"))) + | [ SeTrm (_loc, e) ] -> + if not_computing e + then + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "ising"))), + e) + else + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "lsing"))), + slazy _loc e) + | SeTrm (_loc, e) :: secl -> + if not_computing e + then + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "icons"))), + e), + cstream gloc secl) + else + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "lcons"))), + slazy _loc e), + cstream gloc secl) + | [ SeNtr (_loc, e) ] -> + if not_computing e + then e + else + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "slazy"))), + slazy _loc e) + | SeNtr (_loc, e) :: secl -> + if not_computing e + then + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "iapp"))), + e), + cstream gloc secl) + else + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Stream"), + Ast.IdLid (_loc, "lapp"))), + slazy _loc e), + cstream gloc secl) + (* Syntax extensions in Revised Syntax grammar *) + let _ = + let _ = (expr : 'expr Gram.Entry.t) + and _ = (parser_case_list : 'parser_case_list Gram.Entry.t) + and _ = (parser_case : 'parser_case Gram.Entry.t) + and _ = (stream_quot : 'stream_quot Gram.Entry.t) + and _ = (stream_end : 'stream_end Gram.Entry.t) + and _ = (stream_begin : 'stream_begin Gram.Entry.t) + and _ = (stream_expr : 'stream_expr Gram.Entry.t) in + let grammar_entry_create = Gram.Entry.mk in + let stream_patt : 'stream_patt Gram.Entry.t = + grammar_entry_create "stream_patt" + and stream_expr_comp : 'stream_expr_comp Gram.Entry.t = + grammar_entry_create "stream_expr_comp" + and stream_expr_comp_list : 'stream_expr_comp_list Gram.Entry.t = + grammar_entry_create "stream_expr_comp_list" + and parser_ipatt : 'parser_ipatt Gram.Entry.t = + grammar_entry_create "parser_ipatt" + and stream_patt_comp : 'stream_patt_comp Gram.Entry.t = + grammar_entry_create "stream_patt_comp" + and stream_patt_comp_err_list : + 'stream_patt_comp_err_list Gram.Entry.t = + grammar_entry_create "stream_patt_comp_err_list" + and stream_patt_comp_err : 'stream_patt_comp_err Gram.Entry.t = + grammar_entry_create "stream_patt_comp_err" + in + (Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "top")), + [ (None, None, + [ ([ Gram.Skeyword "match"; Gram.Sself; + Gram.Skeyword "with"; Gram.Skeyword "parser"; + Gram.Sopt + (Gram.Snterm + (Gram.Entry.obj + (parser_ipatt : + 'parser_ipatt Gram.Entry.t))); + Gram.Snterm + (Gram.Entry.obj + (parser_case_list : + 'parser_case_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (pcl : 'parser_case_list) + (po : 'parser_ipatt option) _ _ (e : 'expr) _ + (_loc : Loc.t) -> + (cparser_match _loc e po pcl : 'expr)))); + ([ Gram.Skeyword "parser"; + Gram.Sopt + (Gram.Snterm + (Gram.Entry.obj + (parser_ipatt : + 'parser_ipatt Gram.Entry.t))); + Gram.Snterm + (Gram.Entry.obj + (parser_case_list : + 'parser_case_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (pcl : 'parser_case_list) + (po : 'parser_ipatt option) _ (_loc : Loc.t) + -> (cparser _loc po pcl : 'expr)))) ]) ])) + ()); + Gram.extend (parser_case_list : 'parser_case_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (parser_case : 'parser_case Gram.Entry.t)) ], + (Gram.Action.mk + (fun (pc : 'parser_case) (_loc : Loc.t) -> + ([ pc ] : 'parser_case_list)))); + ([ Gram.Skeyword "["; + Gram.Slist0sep + (Gram.Snterm + (Gram.Entry.obj + (parser_case : 'parser_case Gram.Entry.t)), + Gram.Skeyword "|"); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (pcl : 'parser_case list) _ + (_loc : Loc.t) -> (pcl : 'parser_case_list)))) ]) ])) + ()); + Gram.extend (parser_case : 'parser_case Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (stream_begin : 'stream_begin Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (stream_patt : 'stream_patt Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (stream_end : 'stream_end Gram.Entry.t)); + Gram.Sopt + (Gram.Snterm + (Gram.Entry.obj + (parser_ipatt : + 'parser_ipatt Gram.Entry.t))); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (po : 'parser_ipatt option) _ + (sp : 'stream_patt) _ (_loc : Loc.t) -> + ((sp, po, e) : 'parser_case)))) ]) ])) + ()); + Gram.extend (stream_begin : 'stream_begin Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "[:" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'stream_begin)))) ]) ])) + ()); + Gram.extend (stream_end : 'stream_end Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword ":]" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'stream_end)))) ]) ])) + ()); + Gram.extend (stream_quot : 'stream_quot Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "`" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'stream_quot)))) ]) ])) + ()); + Gram.extend (stream_expr : 'stream_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) (_loc : Loc.t) -> + (e : 'stream_expr)))) ]) ])) + ()); + Gram.extend (stream_patt : 'stream_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> ([] : 'stream_patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_patt_comp : + 'stream_patt_comp Gram.Entry.t)); + Gram.Skeyword ";"; + Gram.Snterm + (Gram.Entry.obj + (stream_patt_comp_err_list : + 'stream_patt_comp_err_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (sp : 'stream_patt_comp_err_list) _ + (spc : 'stream_patt_comp) (_loc : Loc.t) -> + ((spc, None) :: sp : 'stream_patt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_patt_comp : + 'stream_patt_comp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (spc : 'stream_patt_comp) (_loc : Loc.t) -> + ([ (spc, None) ] : 'stream_patt)))) ]) ])) + ()); + Gram.extend + (stream_patt_comp_err : 'stream_patt_comp_err Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (stream_patt_comp : + 'stream_patt_comp Gram.Entry.t)); + Gram.Sopt + (Gram.srules stream_patt_comp_err + [ ([ Gram.Skeyword "??"; + Gram.Snterm + (Gram.Entry.obj + (stream_expr : + 'stream_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'stream_expr) _ + (_loc : Loc.t) -> (e : 'e__6)))) ]) ], + (Gram.Action.mk + (fun (eo : 'e__6 option) + (spc : 'stream_patt_comp) (_loc : Loc.t) -> + ((spc, eo) : 'stream_patt_comp_err)))) ]) ])) + ()); + Gram.extend + (stream_patt_comp_err_list : + 'stream_patt_comp_err_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (stream_patt_comp_err : + 'stream_patt_comp_err Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (sp : 'stream_patt_comp_err_list) _ + (spc : 'stream_patt_comp_err) (_loc : Loc.t) + -> (spc :: sp : 'stream_patt_comp_err_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_patt_comp_err : + 'stream_patt_comp_err Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (spc : 'stream_patt_comp_err) + (_loc : Loc.t) -> + ([ spc ] : 'stream_patt_comp_err_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_patt_comp_err : + 'stream_patt_comp_err Gram.Entry.t)) ], + (Gram.Action.mk + (fun (spc : 'stream_patt_comp_err) + (_loc : Loc.t) -> + ([ spc ] : 'stream_patt_comp_err_list)))) ]) ])) + ()); + Gram.extend (stream_patt_comp : 'stream_patt_comp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) (_loc : Loc.t) -> + (SpStr (_loc, p) : 'stream_patt_comp)))); + ([ Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj + (stream_expr : 'stream_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'stream_expr) _ (p : 'patt) + (_loc : Loc.t) -> + (SpNtr (_loc, p, e) : 'stream_patt_comp)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_quot : 'stream_quot Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)); + Gram.Sopt + (Gram.srules stream_patt_comp + [ ([ Gram.Skeyword "when"; + Gram.Snterm + (Gram.Entry.obj + (stream_expr : + 'stream_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'stream_expr) _ + (_loc : Loc.t) -> (e : 'e__7)))) ]) ], + (Gram.Action.mk + (fun (eo : 'e__7 option) (p : 'patt) _ + (_loc : Loc.t) -> + (SpTrm (_loc, p, eo) : 'stream_patt_comp)))) ]) ])) + ()); + Gram.extend (parser_ipatt : 'parser_ipatt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.PaAny _loc : 'parser_ipatt)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (Ast.PaId (_loc, Ast.IdLid (_loc, i)) : + 'parser_ipatt)))) ]) ])) + ()); + Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "simple")), + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (stream_begin : 'stream_begin Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (stream_expr_comp_list : + 'stream_expr_comp_list Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (stream_end : 'stream_end Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (sel : 'stream_expr_comp_list) _ + (_loc : Loc.t) -> (cstream _loc sel : 'expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_begin : 'stream_begin Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (stream_end : 'stream_end Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> + (cstream _loc [] : 'expr)))) ]) ])) + ()); + Gram.extend + (stream_expr_comp_list : 'stream_expr_comp_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (stream_expr_comp : + 'stream_expr_comp Gram.Entry.t)) ], + (Gram.Action.mk + (fun (se : 'stream_expr_comp) (_loc : Loc.t) -> + ([ se ] : 'stream_expr_comp_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_expr_comp : + 'stream_expr_comp Gram.Entry.t)); + Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (se : 'stream_expr_comp) (_loc : Loc.t) + -> ([ se ] : 'stream_expr_comp_list)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_expr_comp : + 'stream_expr_comp Gram.Entry.t)); + Gram.Skeyword ";"; Gram.Sself ], + (Gram.Action.mk + (fun (sel : 'stream_expr_comp_list) _ + (se : 'stream_expr_comp) (_loc : Loc.t) -> + (se :: sel : 'stream_expr_comp_list)))) ]) ])) + ()); + Gram.extend (stream_expr_comp : 'stream_expr_comp Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (stream_expr : 'stream_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'stream_expr) (_loc : Loc.t) -> + (SeNtr (_loc, e) : 'stream_expr_comp)))); + ([ Gram.Snterm + (Gram.Entry.obj + (stream_quot : 'stream_quot Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (stream_expr : 'stream_expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'stream_expr) _ (_loc : Loc.t) -> + (SeTrm (_loc, e) : 'stream_expr_comp)))) ]) ])) + ())) + end + (* + Gram.Entry.clear stream_expr; + Gram.Entry.clear stream_expr; + stream_expr: + [ [ e = expr LEVEL "stream_expr" -> e ] ] + ; + stream_begin: + [ [ "[<" -> () ] ] + ; + stream_end: + [ [ ">]" -> () ] ] + ; + stream_quot: + [ [ "'" -> () ] ] + ; + *) + module M = Register.OCamlSyntaxExtension(Id)(Make) + end +module G = + struct + open Camlp4 + (* -*- camlp4r -*- *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2002-2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + module Id = + struct + let name = "Camlp4GrammarParser" + let version = "$Id: Grammar.ml,v 1.8 2006/10/04 16:22:54 ertai Exp $" + end + module Make (Syntax : Sig.Camlp4Syntax) = + struct + open Sig + include Syntax + module MetaLoc = Ast.Meta.MetaGhostLoc + module MetaAst = Ast.Meta.Make(MetaLoc) + module PP = Camlp4.Printers.OCaml.Make(Syntax) + let pp = new PP.printer ~comments: false () + let string_of_patt patt = + let buf = Buffer.create 42 in + let () = Format.bprintf buf "%a@?" pp#patt patt in + let str = Buffer.contents buf + in if str = "" then assert false else str + let split_ext = ref false + type loc = Loc.t + type 'e name = { expr : 'e; tvar : string; loc : loc } + type styp = + | STlid of loc * string | STapp of loc * styp * styp + | STquo of loc * string | STself of loc * string | STtok of loc + | STstring_tok of loc | STany of loc | STtyp of Ast.ctyp + type (** The first is the match function expr, + the second is the string description. + The description string will be used for + grammar insertion and left factoring. + Keep this string normalized and well comparable. *) + ('e, 'p) text = + | TXmeta of loc * string * (('e, 'p) text) list * 'e * styp + | TXlist of loc * bool * ('e, 'p) symbol * (('e, 'p) symbol) option + | TXnext of loc | TXnterm of loc * 'e name * string option + | TXopt of loc * ('e, 'p) text + | TXrules of loc * (((('e, 'p) text) list) * 'e) list + | TXself of loc | TXkwd of loc * string + | TXtok of loc * 'e * string + and ('e, 'p) entry = + { name : 'e name; pos : 'e option; levels : (('e, 'p) level) list + } + and ('e, 'p) level = + { label : string option; assoc : 'e option; + rules : (('e, 'p) rule) list + } + and ('e, 'p) rule = + { prod : (('e, 'p) symbol) list; action : 'e option + } + and ('e, 'p) symbol = + { used : string list; text : ('e, 'p) text; styp : styp; + pattern : 'p option + } + type used = | Unused | UsedScanned | UsedNotScanned + let _loc = Loc.ghost + let gm = "Camlp4Grammar__" + let mark_used modif ht n = + try + let rll = Hashtbl.find_all ht n + in + List.iter + (fun (r, _) -> + if !r == Unused + then (r := UsedNotScanned; modif := true) + else ()) + 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 + | Ast.ExId (_, (Ast.IdLid (_, _))) -> 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 _ (r, e) -> + if !r = UsedNotScanned + then + (r := UsedScanned; + List.iter + (fun level -> + let rules = level.rules + in + List.iter + (fun rule -> + List.iter + (fun s -> mark_symbol modif ht s) + rule.prod) + rules) + e.levels) + else ()) + ht + done; + Hashtbl.iter + (fun s (r, e) -> + if !r = Unused + then + Warning.print e.name.loc + ("Unused local entry \"" ^ (s ^ "\"")) + else ()) + ht) + 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.used @ nl) nl r.prod) + [] rl + let retype_rule_list_without_patterns _loc rl = + try + (* ...; [ "foo" ]; ... ==> ...; (x = [ "foo" ] -> Token.extract_string x); ... *) + (* ...; [ symb ]; ... ==> ...; (x = [ symb ] -> x); ... *) + (* ...; ([] -> a); ... *) + List.map + (function + | { + prod = [ ({ pattern = None; styp = STtok _ } as s) ]; + action = None } -> + { + + prod = + [ { + (s) + with + + pattern = + Some (Ast.PaId (_loc, Ast.IdLid (_loc, "x"))); + } ]; + action = + Some + (Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Token"), + Ast.IdLid (_loc, "extract_string"))), + Ast.ExId (_loc, Ast.IdLid (_loc, "x")))); + } + | { prod = [ ({ pattern = None } as s) ]; action = None } -> + { + + prod = + [ { + (s) + with + + pattern = + Some (Ast.PaId (_loc, Ast.IdLid (_loc, "x"))); + } ]; + action = Some (Ast.ExId (_loc, Ast.IdLid (_loc, "x"))); + } + | ({ prod = []; action = Some _ } as r) -> r + | _ -> raise Exit) + rl + with | Exit -> rl + let meta_action = ref false + let mklistexp _loc = + let rec loop top = + function + | [] -> Ast.ExId (_loc, Ast.IdUid (_loc, "[]")) + | e1 :: el -> + let _loc = + if top then _loc else Loc.merge (Ast.loc_of_expr e1) _loc + in + Ast.ExApp (_loc, + Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "::")), + e1), + loop false el) + in loop true + let mklistpat _loc = + let rec loop top = + function + | [] -> Ast.PaId (_loc, Ast.IdUid (_loc, "[]")) + | p1 :: pl -> + let _loc = + if top then _loc else Loc.merge (Ast.loc_of_patt p1) _loc + in + Ast.PaApp (_loc, + Ast.PaApp (_loc, Ast.PaId (_loc, Ast.IdUid (_loc, "::")), + p1), + loop false pl) + in loop true + let rec expr_fa al = + function + | Ast.ExApp (_, f, a) -> expr_fa (a :: al) f + | f -> (f, al) + let rec make_ctyp styp tvar = + match styp with + | STlid (_loc, s) -> Ast.TyId (_loc, Ast.IdLid (_loc, s)) + | STapp (_loc, t1, t2) -> + Ast.TyApp (_loc, make_ctyp t1 tvar, make_ctyp t2 tvar) + | STquo (_loc, s) -> Ast.TyQuo (_loc, s) + | STself (_loc, x) -> + if tvar = "" + then + Loc.raise _loc + (Stream.Error + ("'" ^ (x ^ "' illegal in anonymous entry level"))) + else Ast.TyQuo (_loc, tvar) + | STany _loc -> Ast.TyAny _loc + | STtok _loc -> + Ast.TyId (_loc, + Ast.IdAcc (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Token")), + Ast.IdLid (_loc, "t"))) + | STstring_tok _loc -> Ast.TyId (_loc, Ast.IdLid (_loc, "string")) + | STtyp t -> t + let make_ctyp_patt styp tvar patt = + let styp = + match styp with | STstring_tok _loc -> STtok _loc | t -> t + in + match make_ctyp styp tvar with + | Ast.TyAny _ -> patt + | t -> + let _loc = Ast.loc_of_patt patt in Ast.PaTyc (_loc, patt, t) + let make_ctyp_expr styp tvar expr = + match make_ctyp styp tvar with + | Ast.TyAny _ -> expr + | t -> let _loc = Ast.loc_of_expr expr in Ast.ExTyc (_loc, expr, t) + let text_of_action _loc psl rtvar act tvar = + let locid = Ast.PaId (_loc, Ast.IdLid (_loc, !Loc.name)) in + let act = + match act with + | Some act -> act + | None -> Ast.ExId (_loc, Ast.IdUid (_loc, "()")) in + let (tok_match_pl, act, _) = + List.fold_left + (fun ((tok_match_pl, act, i) as accu) -> + function + | { pattern = None } -> accu + | { pattern = Some p } when Ast.is_irrefut_patt p -> accu + | { + pattern = + Some + (Ast.PaAli (_, + (Ast.PaApp (_, _, (Ast.PaTup (_, (Ast.PaAny _))))), + (Ast.PaId (_, (Ast.IdLid (_, s)))))) + } -> + (tok_match_pl, + (Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, + Ast.PaId (_loc, Ast.IdLid (_loc, s)), + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Token"), + Ast.IdLid (_loc, "extract_string")))), + Ast.ExId (_loc, Ast.IdLid (_loc, s)))), + act)), + i) + | { pattern = Some p; text = TXtok (_, _, _) } -> + let id = "__camlp4_" ^ (string_of_int i) + in + ((Some + (match tok_match_pl with + | None -> + ((Ast.ExId (_loc, Ast.IdLid (_loc, id))), p) + | Some ((tok_pl, match_pl)) -> + ((Ast.ExCom (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, id)), + tok_pl)), + (Ast.PaCom (_loc, p, match_pl))))), + act, (succ i)) + | _ -> accu) + (None, act, 0) psl in + let e = + let e1 = Ast.ExTyc (_loc, act, Ast.TyQuo (_loc, rtvar)) in + let e2 = + match tok_match_pl with + | None -> e1 + | Some ((Ast.ExCom (_, t1, t2), Ast.PaCom (_, p1, p2))) -> + Ast.ExMat (_loc, + Ast.ExTup (_loc, Ast.ExCom (_loc, t1, t2)), + Ast.McOr (_loc, + Ast.McArr (_loc, + Ast.PaTup (_loc, Ast.PaCom (_loc, p1, p2)), + Ast.ExNil _loc, e1), + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, + Ast.ExAsf _loc))) + | Some ((tok, match_)) -> + Ast.ExMat (_loc, tok, + Ast.McOr (_loc, + Ast.McArr (_loc, match_, Ast.ExNil _loc, e1), + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, + Ast.ExAsf _loc))) + in + Ast.ExFun (_loc, + Ast.McArr (_loc, + Ast.PaTyc (_loc, locid, + Ast.TyId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Loc"), + Ast.IdLid (_loc, "t")))), + Ast.ExNil _loc, e2)) in + let (txt, _) = + List.fold_left + (fun (txt, i) s -> + match s.pattern with + | None | Some (Ast.PaAny _) -> + ((Ast.ExFun (_loc, + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, + txt))), + i) + | Some + (Ast.PaAli (_, + (Ast.PaApp (_, _, (Ast.PaTup (_, (Ast.PaAny _))))), + p)) + -> + let p = make_ctyp_patt s.styp tvar p + in + ((Ast.ExFun (_loc, + Ast.McArr (_loc, p, Ast.ExNil _loc, txt))), + i) + | Some p when Ast.is_irrefut_patt p -> + let p = make_ctyp_patt s.styp tvar p + in + ((Ast.ExFun (_loc, + Ast.McArr (_loc, p, Ast.ExNil _loc, txt))), + i) + | Some _ -> + let p = + make_ctyp_patt s.styp tvar + (Ast.PaId (_loc, + Ast.IdLid (_loc, "__camlp4_" ^ (string_of_int i)))) + in + ((Ast.ExFun (_loc, + Ast.McArr (_loc, p, Ast.ExNil _loc, txt))), + (succ i))) + (e, 0) psl in + let txt = + if !meta_action + then + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Obj"), + Ast.IdLid (_loc, "magic"))), + MetaAst.Expr.meta_expr _loc txt) + else txt + in + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Action"), + Ast.IdLid (_loc, "mk")))), + txt) + let srules loc t rl tvar = + List.map + (fun r -> + let sl = List.map (fun s -> s.text) r.prod in + let ac = text_of_action loc r.prod t r.action tvar in (sl, ac)) + rl + let rec make_expr entry tvar = + function + | TXmeta (_loc, n, tl, e, t) -> + let el = + List.fold_right + (fun t el -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "::")), + make_expr entry "" t), + el)) + tl (Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))) + in + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Smeta"))), + Ast.ExStr (_loc, n)), + el), + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Action"), + Ast.IdLid (_loc, "mk")))), + make_ctyp_expr t tvar e)) + | TXlist (_loc, min, t, ts) -> + let txt = make_expr entry "" t.text + in + (match (min, ts) with + | (false, None) -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Slist0"))), + txt) + | (true, None) -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Slist1"))), + txt) + | (false, Some s) -> + let x = make_expr entry tvar s.text + in + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Slist0sep"))), + txt), + x) + | (true, Some s) -> + let x = make_expr entry tvar s.text + in + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Slist1sep"))), + txt), + x)) + | TXnext _loc -> + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Snext"))) + | TXnterm (_loc, n, lev) -> + (match lev with + | Some lab -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Snterml"))), + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Entry"), + Ast.IdLid (_loc, "obj")))), + Ast.ExTyc (_loc, n.expr, + Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Entry")), + Ast.IdLid (_loc, "t"))), + Ast.TyQuo (_loc, n.tvar))))), + Ast.ExStr (_loc, lab)) + | None -> + if n.tvar = tvar + then + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Sself"))) + else + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Snterm"))), + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Entry"), + Ast.IdLid (_loc, "obj")))), + Ast.ExTyc (_loc, n.expr, + Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Entry")), + Ast.IdLid (_loc, "t"))), + Ast.TyQuo (_loc, n.tvar)))))) + | TXopt (_loc, t) -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Sopt"))), + make_expr entry "" t) + | TXrules (_loc, rl) -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdLid (_loc, "srules"))), + entry.expr), + make_expr_rules _loc entry rl "") + | TXself _loc -> + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Sself"))) + | TXkwd (_loc, kwd) -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Skeyword"))), + Ast.ExStr (_loc, kwd)) + | TXtok (_loc, match_fun, descr) -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Stoken"))), + Ast.ExTup (_loc, + Ast.ExCom (_loc, match_fun, + Ast.ExStr (_loc, Ast.safe_string_escaped descr)))) + and make_expr_rules _loc n rl tvar = + List.fold_left + (fun txt (sl, ac) -> + let sl = + List.fold_right + (fun t txt -> + let x = make_expr n tvar t + in + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "::")), x), + txt)) + sl (Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))) + in + Ast.ExApp (_loc, + Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "::")), + Ast.ExTup (_loc, Ast.ExCom (_loc, sl, ac))), + txt)) + (Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))) rl + let expr_of_delete_rule _loc n sl = + let sl = + List.fold_right + (fun s e -> + Ast.ExApp (_loc, + Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "::")), + make_expr n "" s.text), + e)) + sl (Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))) + in ((n.expr), sl) + let rec tvar_of_ident = + function + | Ast.IdLid (_, x) | Ast.IdUid (_, x) -> x + | Ast.IdAcc (_, (Ast.IdUid (_, x)), xs) -> + x ^ ("__" ^ (tvar_of_ident xs)) + | _ -> failwith "internal error in the Grammar extension" + let mk_name _loc i = + { expr = Ast.ExId (_loc, i); tvar = tvar_of_ident i; loc = _loc; } + let slist loc min sep symb = TXlist (loc, min, symb, sep) + let sstoken _loc s = + let n = mk_name _loc (Ast.IdLid (_loc, "a_" ^ s)) + in TXnterm (_loc, n, None) + let mk_symbol p s t = + { used = []; text = s; styp = t; pattern = Some p; } + let sslist _loc min sep s = + let rl = + let r1 = + let prod = + let n = mk_name _loc (Ast.IdLid (_loc, "a_list")) + in + [ mk_symbol (Ast.PaId (_loc, Ast.IdLid (_loc, "a"))) + (TXnterm (_loc, n, None)) (STquo (_loc, "a_list")) ] in + let act = Ast.ExId (_loc, Ast.IdLid (_loc, "a")) + in { prod = prod; action = Some act; } in + let r2 = + let prod = + [ mk_symbol (Ast.PaId (_loc, Ast.IdLid (_loc, "a"))) + (slist _loc min sep s) + (STapp (_loc, STlid (_loc, "list"), s.styp)) ] in + let act = + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Qast"), + Ast.IdUid (_loc, "List"))), + Ast.ExId (_loc, Ast.IdLid (_loc, "a"))) + in { prod = prod; action = Some act; } + in [ r1; r2 ] in + let used = + match sep with | Some symb -> symb.used @ s.used | None -> s.used in + let used = "a_list" :: used in + let text = TXrules (_loc, srules _loc "a_list" rl "") in + let styp = STquo (_loc, "a_list") + in { used = used; text = text; styp = styp; pattern = None; } + let ssopt _loc s = + let rl = + let r1 = + let prod = + let n = mk_name _loc (Ast.IdLid (_loc, "a_opt")) + in + [ mk_symbol (Ast.PaId (_loc, Ast.IdLid (_loc, "a"))) + (TXnterm (_loc, n, None)) (STquo (_loc, "a_opt")) ] in + let act = Ast.ExId (_loc, Ast.IdLid (_loc, "a")) + in { prod = prod; action = Some act; } in + let r2 = + let s = + match s.text with + | TXkwd (_loc, _) | TXtok (_loc, _, _) -> + let rl = + [ { + + prod = + [ { + (s) + with + + pattern = + Some + (Ast.PaId (_loc, Ast.IdLid (_loc, "x"))); + } ]; + action = + Some + (Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Qast"), + Ast.IdUid (_loc, "Str"))), + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Token"), + Ast.IdLid (_loc, "extract_string"))), + Ast.ExId (_loc, Ast.IdLid (_loc, "x"))))); + } ] in + let t = new_type_var () + in + { + + used = []; + text = TXrules (_loc, srules _loc t rl ""); + styp = STquo (_loc, t); + pattern = None; + } + | _ -> s in + let prod = + [ mk_symbol (Ast.PaId (_loc, Ast.IdLid (_loc, "a"))) + (TXopt (_loc, s.text)) + (STapp (_loc, STlid (_loc, "option"), s.styp)) ] in + let act = + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Qast"), + Ast.IdUid (_loc, "Option"))), + Ast.ExId (_loc, Ast.IdLid (_loc, "a"))) + in { prod = prod; action = Some act; } + in [ r1; r2 ] in + let used = "a_opt" :: s.used in + let text = TXrules (_loc, srules _loc "a_opt" rl "") in + let styp = STquo (_loc, "a_opt") + in { used = used; text = text; styp = styp; pattern = None; } + let text_of_entry _loc e = + let ent = + let x = e.name in + let _loc = e.name.loc + in + Ast.ExTyc (_loc, x.expr, + Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Entry")), + Ast.IdLid (_loc, "t"))), + Ast.TyQuo (_loc, x.tvar))) in + let pos = + match e.pos with + | Some pos -> + Ast.ExApp (_loc, Ast.ExId (_loc, Ast.IdUid (_loc, "Some")), + pos) + | None -> Ast.ExId (_loc, Ast.IdUid (_loc, "None")) in + let txt = + List.fold_right + (fun level txt -> + let lab = + match level.label with + | Some lab -> + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "Some")), + Ast.ExStr (_loc, lab)) + | None -> Ast.ExId (_loc, Ast.IdUid (_loc, "None")) in + let ass = + match level.assoc with + | Some ass -> + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "Some")), ass) + | None -> Ast.ExId (_loc, Ast.IdUid (_loc, "None")) in + let txt = + let rl = + srules _loc e.name.tvar level.rules e.name.tvar in + let e = make_expr_rules _loc e.name rl e.name.tvar + in + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "::")), + Ast.ExTup (_loc, + Ast.ExCom (_loc, lab, Ast.ExCom (_loc, ass, e)))), + txt) + in txt) + e.levels (Ast.ExId (_loc, Ast.IdUid (_loc, "[]"))) + in (ent, pos, txt) + let let_in_of_extend _loc gram gl el args = + match gl with + | None -> args + | Some nl -> + (check_use nl el; + let ll = + let same_tvar e n = e.name.tvar = n.tvar + in + List.fold_right + (fun e ll -> + match e.name.expr with + | Ast.ExId (_, (Ast.IdLid (_, _))) -> + if List.exists (same_tvar e) nl + then ll + else + if List.exists (same_tvar e) ll + then ll + else e.name :: ll + | _ -> ll) + el [] in + let local_binding_of_name { expr = e; tvar = x; loc = _loc } = + let i = + (match e with + | Ast.ExId (_, (Ast.IdLid (_, i))) -> i + | _ -> failwith "internal error in the Grammar extension") + in + Ast.BiEq (_loc, Ast.PaId (_loc, Ast.IdLid (_loc, i)), + Ast.ExTyc (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdLid (_loc, "grammar_entry_create")), + Ast.ExStr (_loc, i)), + Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Entry")), + Ast.IdLid (_loc, "t"))), + Ast.TyQuo (_loc, x)))) in + let expr_of_name { expr = e; tvar = x; loc = _loc } = + Ast.ExTyc (_loc, e, + Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdUid (_loc, "Entry")), + Ast.IdLid (_loc, "t"))), + Ast.TyQuo (_loc, x))) in + let e = + (match ll with + | [] -> args + | x :: xs -> + let locals = + List.fold_right + (fun name acc -> + Ast.BiAnd (_loc, acc, + local_binding_of_name name)) + xs (local_binding_of_name x) in + let entry_mk = + (match gram with + | Some g -> + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Entry"), + Ast.IdLid (_loc, "mk")))), + Ast.ExId (_loc, g)) + | None -> + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Entry"), + Ast.IdLid (_loc, "mk"))))) + in + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, + Ast.PaId (_loc, + Ast.IdLid (_loc, "grammar_entry_create")), + entry_mk), + Ast.ExLet (_loc, Ast.BFalse, locals, args))) + in + (match nl with + | [] -> e + | x :: xs -> + let globals = + List.fold_right + (fun name acc -> + Ast.BiAnd (_loc, acc, + Ast.BiEq (_loc, Ast.PaAny _loc, + expr_of_name name))) + xs + (Ast.BiEq (_loc, Ast.PaAny _loc, expr_of_name x)) + in Ast.ExLet (_loc, Ast.BFalse, globals, e))) + class subst gmod = + object inherit Ast.map as super + method ident = + function + | Ast.IdUid (_, x) when x = gm -> gmod + | x -> super#ident x + end + let subst_gmod ast gmod = (new subst gmod)#expr ast + let text_of_functorial_extend _loc gmod gram gl el = + let args = + let el = + List.map + (fun e -> + let (ent, pos, txt) = text_of_entry e.name.loc e in + let e = + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdLid (_loc, "extend"))), + ent), + Ast.ExApp (_loc, + Ast.ExFun (_loc, + Ast.McArr (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, "()")), + Ast.ExNil _loc, + Ast.ExTup (_loc, Ast.ExCom (_loc, pos, txt)))), + Ast.ExId (_loc, Ast.IdUid (_loc, "()")))) + in + if !split_ext + then + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, + Ast.PaId (_loc, Ast.IdLid (_loc, "aux")), + Ast.ExFun (_loc, + Ast.McArr (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, "()")), + Ast.ExNil _loc, e))), + Ast.ExApp (_loc, + Ast.ExId (_loc, Ast.IdLid (_loc, "aux")), + Ast.ExId (_loc, Ast.IdUid (_loc, "()")))) + else e) + el + in + match el with + | [] -> Ast.ExId (_loc, Ast.IdUid (_loc, "()")) + | [ e ] -> e + | e :: el -> + Ast.ExSeq (_loc, + List.fold_left (fun acc x -> Ast.ExSem (_loc, acc, x)) e + el) + in subst_gmod (let_in_of_extend _loc gram gl el args) gmod + let wildcarder = + object (self) + inherit Ast.map as super + method patt = + function + | Ast.PaId (_loc, (Ast.IdLid (_, _))) -> Ast.PaAny _loc + | Ast.PaAli (_, p, _) -> self#patt p + | Ast.PaEq (_loc, p1, p2) -> Ast.PaEq (_loc, p1, self#patt p2) + | p -> super#patt p + end + let mk_tok _loc p t = + let p' = wildcarder#patt p in + let match_fun = + if Ast.is_irrefut_patt p' + then + Ast.ExFun (_loc, + Ast.McArr (_loc, p', Ast.ExNil _loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "True")))) + else + Ast.ExFun (_loc, + Ast.McOr (_loc, + Ast.McArr (_loc, p', Ast.ExNil _loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "True"))), + Ast.McArr (_loc, Ast.PaAny _loc, Ast.ExNil _loc, + Ast.ExId (_loc, Ast.IdUid (_loc, "False"))))) in + let descr = string_of_patt p' in + let text = TXtok (_loc, match_fun, descr) + in { used = []; text = text; styp = t; pattern = Some p; } + let symbol = Gram.Entry.mk "symbol" + let check_not_tok s = + match s with + | { text = TXtok (_loc, _, _) } -> + Loc.raise _loc + (Stream.Error + ("Deprecated syntax, use a sub rule. " ^ + "LIST0 STRING becomes LIST0 [ x = STRING -> x ]")) + | _ -> () + let _ = + let _ = (expr : 'expr Gram.Entry.t) + and _ = (symbol : 'symbol Gram.Entry.t) in + let grammar_entry_create = Gram.Entry.mk in + let extend_header : 'extend_header Gram.Entry.t = + grammar_entry_create "extend_header" + and semi_sep : 'semi_sep Gram.Entry.t = + grammar_entry_create "semi_sep" + and string : 'string Gram.Entry.t = grammar_entry_create "string" + and name : 'name Gram.Entry.t = grammar_entry_create "name" + and comma_patt : 'comma_patt Gram.Entry.t = + grammar_entry_create "comma_patt" + and pattern : 'pattern Gram.Entry.t = + grammar_entry_create "pattern" + and psymbol : 'psymbol Gram.Entry.t = + grammar_entry_create "psymbol" + and rule : 'rule Gram.Entry.t = grammar_entry_create "rule" + and rule_list : 'rule_list Gram.Entry.t = + grammar_entry_create "rule_list" + and assoc : 'assoc Gram.Entry.t = grammar_entry_create "assoc" + and level : 'level Gram.Entry.t = grammar_entry_create "level" + and level_list : 'level_list Gram.Entry.t = + grammar_entry_create "level_list" + and position : 'position Gram.Entry.t = + grammar_entry_create "position" + and entry : 'entry Gram.Entry.t = grammar_entry_create "entry" + and global : 'global Gram.Entry.t = grammar_entry_create "global" + and t_qualid : 't_qualid Gram.Entry.t = + grammar_entry_create "t_qualid" + and qualid : 'qualid Gram.Entry.t = grammar_entry_create "qualid" + and qualuid : 'qualuid Gram.Entry.t = + grammar_entry_create "qualuid" + and delete_rule_body : 'delete_rule_body Gram.Entry.t = + grammar_entry_create "delete_rule_body" + and extend_body : 'extend_body Gram.Entry.t = + grammar_entry_create "extend_body" + in + (Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.After "top")), + [ (None, None, + [ ([ Gram.Skeyword "GEXTEND" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Loc.raise _loc + (Stream.Error + "Deprecated syntax, use EXTEND MyGramModule ... END instead") : + 'expr)))); + ([ Gram.Skeyword "GDELETE_RULE" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Loc.raise _loc + (Stream.Error + "Deprecated syntax, use DELETE_RULE MyGramModule ... END instead") : + 'expr)))); + ([ Gram.Skeyword "DELETE_RULE"; + Gram.Snterm + (Gram.Entry.obj + (delete_rule_body : + 'delete_rule_body Gram.Entry.t)); + Gram.Skeyword "END" ], + (Gram.Action.mk + (fun _ (e : 'delete_rule_body) _ (_loc : Loc.t) + -> (e : 'expr)))); + ([ Gram.Skeyword "EXTEND"; + Gram.Snterm + (Gram.Entry.obj + (extend_body : 'extend_body Gram.Entry.t)); + Gram.Skeyword "END" ], + (Gram.Action.mk + (fun _ (e : 'extend_body) _ (_loc : Loc.t) -> + (e : 'expr)))) ]) ])) + ()); + Gram.extend (extend_header : 'extend_header Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (qualuid : 'qualuid Gram.Entry.t)) ], + (Gram.Action.mk + (fun (g : 'qualuid) (_loc : Loc.t) -> + ((None, g) : 'extend_header)))); + ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj (qualid : 'qualid Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Snterm + (Gram.Entry.obj + (t_qualid : 't_qualid Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (t : 't_qualid) _ (i : 'qualid) _ + (_loc : Loc.t) -> + (((Some i), t) : 'extend_header)))) ]) ])) + ()); + Gram.extend (extend_body : 'extend_body Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (extend_header : + 'extend_header Gram.Entry.t)); + Gram.Sopt + (Gram.Snterm + (Gram.Entry.obj + (global : 'global Gram.Entry.t))); + Gram.Slist1 + (Gram.srules extend_body + [ ([ Gram.Snterm + (Gram.Entry.obj + (entry : 'entry Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (semi_sep : + 'semi_sep Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (e : 'entry) (_loc : Loc.t) -> + (e : 'e__8)))) ]) ], + (Gram.Action.mk + (fun (el : 'e__8 list) + (global_list : 'global option) + ((gram, g) : 'extend_header) (_loc : Loc.t) + -> + (text_of_functorial_extend _loc g gram + global_list el : + 'extend_body)))) ]) ])) + ()); + Gram.extend (delete_rule_body : 'delete_rule_body Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (qualuid : 'qualuid Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (name : 'name Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Slist0sep + (Gram.Snterm + (Gram.Entry.obj + (symbol : 'symbol Gram.Entry.t)), + Gram.Snterm + (Gram.Entry.obj + (semi_sep : 'semi_sep Gram.Entry.t))) ], + (Gram.Action.mk + (fun (sl : 'symbol list) _ (n : 'name) + (g : 'qualuid) (_loc : Loc.t) -> + (let (e, b) = expr_of_delete_rule _loc n sl + in + subst_gmod + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, gm), + Ast.IdLid (_loc, "delete_rule"))), + e), + b)) + g : + 'delete_rule_body)))) ]) ])) + ()); + Gram.extend (qualuid : 'qualuid Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.srules qualuid + [ ([ Gram.Stoken + (((function + | UIDENT "GLOBAL" -> true + | _ -> false), + "UIDENT \"GLOBAL\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "GLOBAL" -> (() : 'e__9) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | LIDENT ((_)) -> true + | _ -> false), + "LIDENT ((_))")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | LIDENT ((_)) -> (() : 'e__9) + | _ -> assert false))) ] ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Loc.raise _loc + (Stream.Error + "Deprecated syntax, the grammar module is expected") : + 'qualuid)))) ]); + (None, None, + [ ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")) ], + (Gram.Action.mk + (fun (i : Gram.Token.t) (_loc : Loc.t) -> + (let i = Gram.Token.extract_string i + in Ast.IdUid (_loc, i) : 'qualuid)))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (xs : 'qualuid) _ (x : Gram.Token.t) + (_loc : Loc.t) -> + (let x = Gram.Token.extract_string x + in Ast.IdAcc (_loc, Ast.IdUid (_loc, x), xs) : + 'qualuid)))) ]) ])) + ()); + Gram.extend (qualuid : 'qualuid Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.srules qualuid + [ ([ Gram.Stoken + (((function + | UIDENT "GLOBAL" -> true + | _ -> false), + "UIDENT \"GLOBAL\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "GLOBAL" -> (() : 'e__10) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | LIDENT ((_)) -> true + | _ -> false), + "LIDENT ((_))")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | LIDENT ((_)) -> (() : 'e__10) + | _ -> assert false))) ] ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Loc.raise _loc + (Stream.Error + "Deprecated syntax, the grammar module is expected") : + 'qualuid)))) ]); + (None, None, + [ ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")) ], + (Gram.Action.mk + (fun (i : Gram.Token.t) (_loc : Loc.t) -> + (let i = Gram.Token.extract_string i + in Ast.IdUid (_loc, i) : 'qualuid)))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (xs : 'qualuid) _ (x : Gram.Token.t) + (_loc : Loc.t) -> + (let x = Gram.Token.extract_string x + in Ast.IdAcc (_loc, Ast.IdUid (_loc, x), xs) : + 'qualuid)))) ]) ])) + ()); + Gram.extend (qualid : 'qualid Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | LIDENT ((_)) -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (i : Gram.Token.t) (_loc : Loc.t) -> + (let i = Gram.Token.extract_string i + in Ast.IdLid (_loc, i) : 'qualid)))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")) ], + (Gram.Action.mk + (fun (i : Gram.Token.t) (_loc : Loc.t) -> + (let i = Gram.Token.extract_string i + in Ast.IdUid (_loc, i) : 'qualid)))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (xs : 'qualid) _ (x : Gram.Token.t) + (_loc : Loc.t) -> + (let x = Gram.Token.extract_string x + in Ast.IdAcc (_loc, Ast.IdUid (_loc, x), xs) : + 'qualid)))) ]) ])) + ()); + Gram.extend (t_qualid : 't_qualid Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | LIDENT _ | UIDENT _ -> true + | _ -> false), + "LIDENT _ | UIDENT _")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | LIDENT _ | UIDENT _ -> + (Loc.raise _loc + (Stream.Error + ("Wrong EXTEND header, the grammar type must finish by 't', " + ^ + "like in EXTEND (g : Gram.t) ... END")) : + 't_qualid) + | _ -> assert false))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")); + Gram.Skeyword "."; + Gram.Stoken + (((function | LIDENT "t" -> true | _ -> false), + "LIDENT \"t\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) _ + (x : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | LIDENT "t" -> + (let x = Gram.Token.extract_string x + in Ast.IdUid (_loc, x) : 't_qualid) + | _ -> assert false))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")); + Gram.Skeyword "."; Gram.Sself ], + (Gram.Action.mk + (fun (xs : 't_qualid) _ (x : Gram.Token.t) + (_loc : Loc.t) -> + (let x = Gram.Token.extract_string x + in Ast.IdAcc (_loc, Ast.IdUid (_loc, x), xs) : + 't_qualid)))) ]) ])) + ()); + Gram.extend (global : 'global Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | UIDENT "GLOBAL" -> true + | _ -> false), + "UIDENT \"GLOBAL\"")); + Gram.Skeyword ":"; + Gram.Slist1 + (Gram.Snterm + (Gram.Entry.obj (name : 'name Gram.Entry.t))); + Gram.Snterm + (Gram.Entry.obj + (semi_sep : 'semi_sep Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (sl : 'name list) _ + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "GLOBAL" -> (sl : 'global) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (entry : 'entry Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (name : 'name Gram.Entry.t)); + Gram.Skeyword ":"; + Gram.Sopt + (Gram.Snterm + (Gram.Entry.obj + (position : 'position Gram.Entry.t))); + Gram.Snterm + (Gram.Entry.obj + (level_list : 'level_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (ll : 'level_list) (pos : 'position option) + _ (n : 'name) (_loc : Loc.t) -> + ({ name = n; pos = pos; levels = ll; } : + 'entry)))) ]) ])) + ()); + Gram.extend (position : 'position Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | UIDENT "LEVEL" -> true + | _ -> false), + "UIDENT \"LEVEL\"")); + Gram.Snterm + (Gram.Entry.obj (string : 'string Gram.Entry.t)) ], + (Gram.Action.mk + (fun (n : 'string) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "LEVEL" -> + (Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Camlp4"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Sig"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Grammar"), + Ast.IdUid (_loc, "Level"))))), + n) : + 'position) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "AFTER" -> true + | _ -> false), + "UIDENT \"AFTER\"")); + Gram.Snterm + (Gram.Entry.obj (string : 'string Gram.Entry.t)) ], + (Gram.Action.mk + (fun (n : 'string) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "AFTER" -> + (Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Camlp4"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Sig"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Grammar"), + Ast.IdUid (_loc, "After"))))), + n) : + 'position) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "BEFORE" -> true + | _ -> false), + "UIDENT \"BEFORE\"")); + Gram.Snterm + (Gram.Entry.obj (string : 'string Gram.Entry.t)) ], + (Gram.Action.mk + (fun (n : 'string) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "BEFORE" -> + (Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Camlp4"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Sig"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Grammar"), + Ast.IdUid (_loc, "Before"))))), + n) : + 'position) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "LAST" -> true + | _ -> false), + "UIDENT \"LAST\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | UIDENT "LAST" -> + (Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Camlp4"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Sig"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Grammar"), + Ast.IdUid (_loc, "Last"))))) : + 'position) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "FIRST" -> true + | _ -> false), + "UIDENT \"FIRST\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | UIDENT "FIRST" -> + (Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Camlp4"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Sig"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Grammar"), + Ast.IdUid (_loc, "First"))))) : + 'position) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (level_list : 'level_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "["; + Gram.Slist0sep + (Gram.Snterm + (Gram.Entry.obj + (level : 'level Gram.Entry.t)), + Gram.Skeyword "|"); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (ll : 'level list) _ (_loc : Loc.t) -> + (ll : 'level_list)))) ]) ])) + ()); + Gram.extend (level : 'level Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Sopt + (Gram.srules level + [ ([ Gram.Stoken + (((function + | STRING ((_)) -> true + | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (x : Gram.Token.t) (_loc : Loc.t) + -> + (let x = + Gram.Token.extract_string x + in x : 'e__11)))) ]); + Gram.Sopt + (Gram.Snterm + (Gram.Entry.obj + (assoc : 'assoc Gram.Entry.t))); + Gram.Snterm + (Gram.Entry.obj + (rule_list : 'rule_list Gram.Entry.t)) ], + (Gram.Action.mk + (fun (rules : 'rule_list) (ass : 'assoc option) + (lab : 'e__11 option) (_loc : Loc.t) -> + ({ label = lab; assoc = ass; rules = rules; + } : 'level)))) ]) ])) + ()); + Gram.extend (assoc : 'assoc Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | UIDENT "NONA" -> true + | _ -> false), + "UIDENT \"NONA\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | UIDENT "NONA" -> + (Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Camlp4"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Sig"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Grammar"), + Ast.IdUid (_loc, "NonA"))))) : + 'assoc) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "RIGHTA" -> true + | _ -> false), + "UIDENT \"RIGHTA\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | UIDENT "RIGHTA" -> + (Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Camlp4"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Sig"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Grammar"), + Ast.IdUid (_loc, "RightA"))))) : + 'assoc) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "LEFTA" -> true + | _ -> false), + "UIDENT \"LEFTA\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | UIDENT "LEFTA" -> + (Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Camlp4"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Sig"), + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Grammar"), + Ast.IdUid (_loc, "LeftA"))))) : + 'assoc) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (rule_list : 'rule_list Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "["; + Gram.Slist1sep + (Gram.Snterm + (Gram.Entry.obj (rule : 'rule Gram.Entry.t)), + Gram.Skeyword "|"); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rules : 'rule list) _ (_loc : Loc.t) -> + (retype_rule_list_without_patterns _loc rules : + 'rule_list)))); + ([ Gram.Skeyword "["; Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ _ (_loc : Loc.t) -> ([] : 'rule_list)))) ]) ])) + ()); + Gram.extend (rule : 'rule Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Slist0sep + (Gram.Snterm + (Gram.Entry.obj + (psymbol : 'psymbol Gram.Entry.t)), + Gram.Snterm + (Gram.Entry.obj + (semi_sep : 'semi_sep Gram.Entry.t))) ], + (Gram.Action.mk + (fun (psl : 'psymbol list) (_loc : Loc.t) -> + ({ prod = psl; action = None; } : 'rule)))); + ([ Gram.Slist0sep + (Gram.Snterm + (Gram.Entry.obj + (psymbol : 'psymbol Gram.Entry.t)), + Gram.Snterm + (Gram.Entry.obj + (semi_sep : 'semi_sep Gram.Entry.t))); + Gram.Skeyword "->"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (act : 'expr) _ (psl : 'psymbol list) + (_loc : Loc.t) -> + ({ prod = psl; action = Some act; } : 'rule)))) ]) ])) + ()); + Gram.extend (psymbol : 'psymbol Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (symbol : 'symbol Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'symbol) (_loc : Loc.t) -> + (s : 'psymbol)))); + ([ Gram.Snterm + (Gram.Entry.obj + (pattern : 'pattern Gram.Entry.t)); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (symbol : 'symbol Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'symbol) _ (p : 'pattern) + (_loc : Loc.t) -> + (match s.pattern with + | Some + (Ast.PaApp (_, + (Ast.PaId (_, (Ast.IdUid (_, u)))), + (Ast.PaTup (_, (Ast.PaAny _))))) + -> + mk_tok _loc + (Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdUid (_loc, u)), + p)) + s.styp + | _ -> { (s) with pattern = Some p; } : + 'psymbol)))); + ([ Gram.Stoken + (((function | LIDENT ((_)) -> true | _ -> false), + "LIDENT _")); + Gram.Sopt + (Gram.srules psymbol + [ ([ Gram.Stoken + (((function + | UIDENT "LEVEL" -> true + | _ -> false), + "UIDENT \"LEVEL\"")); + Gram.Stoken + (((function + | STRING ((_)) -> true + | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (s : Gram.Token.t) + (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "LEVEL" -> + (let s = + Gram.Token.extract_string s + in s : 'e__12) + | _ -> assert false))) ]) ], + (Gram.Action.mk + (fun (lev : 'e__12 option) (i : Gram.Token.t) + (_loc : Loc.t) -> + (let i = Gram.Token.extract_string i in + let name = + mk_name _loc (Ast.IdLid (_loc, i)) in + let text = TXnterm (_loc, name, lev) in + let styp = STquo (_loc, i) + in + { + + used = [ i ]; + text = text; + styp = styp; + pattern = None; + } : + 'psymbol)))); + ([ Gram.Stoken + (((function | LIDENT ((_)) -> true | _ -> false), + "LIDENT _")); + Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (symbol : 'symbol Gram.Entry.t)) ], + (Gram.Action.mk + (fun (s : 'symbol) _ (p : Gram.Token.t) + (_loc : Loc.t) -> + (let p = Gram.Token.extract_string p + in + match s.pattern with + | Some + ((Ast.PaApp (_, + (Ast.PaId (_, (Ast.IdUid (_, u)))), + (Ast.PaTup (_, (Ast.PaAny _)))) + as p')) + -> + let match_fun = + Ast.ExFun (_loc, + Ast.McOr (_loc, + Ast.McArr (_loc, p', + Ast.ExNil _loc, + Ast.ExId (_loc, + Ast.IdUid (_loc, "True"))), + Ast.McArr (_loc, Ast.PaAny _loc, + Ast.ExNil _loc, + Ast.ExId (_loc, + Ast.IdUid (_loc, "False"))))) in + let p' = + Ast.PaAli (_loc, p', + Ast.PaId (_loc, + Ast.IdLid (_loc, p))) in + let descr = u ^ " _" in + let text = + TXtok (_loc, match_fun, descr) + in + { + (s) + with + + text = text; + pattern = Some p'; + } + | _ -> + { + (s) + with + + pattern = + Some + (Ast.PaId (_loc, + Ast.IdLid (_loc, p))); + } : + 'psymbol)))) ]) ])) + ()); + Gram.extend (symbol : 'symbol Gram.Entry.t) + ((fun () -> + (None, + [ ((Some "top"), (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Stoken + (((function | UIDENT "OPT" -> true | _ -> false), + "UIDENT \"OPT\"")); + Gram.Sself ], + (Gram.Action.mk + (fun (s : 'symbol) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "OPT" -> + (let () = check_not_tok s in + let styp = + STapp (_loc, STlid (_loc, "option"), + s.styp) in + let text = TXopt (_loc, s.text) + in + { + + used = s.used; + text = text; + styp = styp; + pattern = None; + } : + 'symbol) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "LIST1" -> true + | _ -> false), + "UIDENT \"LIST1\"")); + Gram.Sself; + Gram.Sopt + (Gram.srules symbol + [ ([ Gram.Stoken + (((function + | UIDENT "SEP" -> true + | _ -> false), + "UIDENT \"SEP\"")); + Gram.Snterm + (Gram.Entry.obj + (symbol : 'symbol Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'symbol) + (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "SEP" -> (t : 'e__14) + | _ -> assert false))) ]) ], + (Gram.Action.mk + (fun (sep : 'e__14 option) (s : 'symbol) + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "LIST1" -> + (let () = check_not_tok s in + let used = + (match sep with + | Some symb -> symb.used @ s.used + | None -> s.used) in + let styp = + STapp (_loc, STlid (_loc, "list"), + s.styp) in + let text = slist _loc true sep s + in + { + + used = used; + text = text; + styp = styp; + pattern = None; + } : + 'symbol) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "LIST0" -> true + | _ -> false), + "UIDENT \"LIST0\"")); + Gram.Sself; + Gram.Sopt + (Gram.srules symbol + [ ([ Gram.Stoken + (((function + | UIDENT "SEP" -> true + | _ -> false), + "UIDENT \"SEP\"")); + Gram.Snterm + (Gram.Entry.obj + (symbol : 'symbol Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'symbol) + (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "SEP" -> (t : 'e__13) + | _ -> assert false))) ]) ], + (Gram.Action.mk + (fun (sep : 'e__13 option) (s : 'symbol) + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "LIST0" -> + (let () = check_not_tok s in + let used = + (match sep with + | Some symb -> symb.used @ s.used + | None -> s.used) in + let styp = + STapp (_loc, STlid (_loc, "list"), + s.styp) in + let text = slist _loc false sep s + in + { + + used = used; + text = text; + styp = styp; + pattern = None; + } : + 'symbol) + | _ -> assert false))) ]); + (None, None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (s_t : 'symbol) _ (_loc : Loc.t) -> + (s_t : 'symbol)))); + ([ Gram.Snterm + (Gram.Entry.obj (name : 'name Gram.Entry.t)); + Gram.Sopt + (Gram.srules symbol + [ ([ Gram.Stoken + (((function + | UIDENT "LEVEL" -> true + | _ -> false), + "UIDENT \"LEVEL\"")); + Gram.Stoken + (((function + | STRING ((_)) -> true + | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (s : Gram.Token.t) + (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "LEVEL" -> + (let s = + Gram.Token.extract_string s + in s : 'e__16) + | _ -> assert false))) ]) ], + (Gram.Action.mk + (fun (lev : 'e__16 option) (n : 'name) + (_loc : Loc.t) -> + ({ + + used = [ n.tvar ]; + text = TXnterm (_loc, n, lev); + styp = STquo (_loc, n.tvar); + pattern = None; + } : 'symbol)))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")); + Gram.Skeyword "."; + Gram.Snterm + (Gram.Entry.obj (qualid : 'qualid Gram.Entry.t)); + Gram.Sopt + (Gram.srules symbol + [ ([ Gram.Stoken + (((function + | UIDENT "LEVEL" -> true + | _ -> false), + "UIDENT \"LEVEL\"")); + Gram.Stoken + (((function + | STRING ((_)) -> true + | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (s : Gram.Token.t) + (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "LEVEL" -> + (let s = + Gram.Token.extract_string s + in s : 'e__15) + | _ -> assert false))) ]) ], + (Gram.Action.mk + (fun (lev : 'e__15 option) (il : 'qualid) _ + (i : Gram.Token.t) (_loc : Loc.t) -> + (let i = Gram.Token.extract_string i in + let n = + mk_name _loc + (Ast.IdAcc (_loc, Ast.IdUid (_loc, i), + il)) + in + { + + used = [ n.tvar ]; + text = TXnterm (_loc, n, lev); + styp = STquo (_loc, n.tvar); + pattern = None; + } : + 'symbol)))); + ([ Gram.Stoken + (((function | STRING ((_)) -> true | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (s : Gram.Token.t) (_loc : Loc.t) -> + (let s = Gram.Token.extract_string s + in + { + + used = []; + text = TXkwd (_loc, s); + styp = STtok _loc; + pattern = None; + } : + 'symbol)))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")); + Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (x : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | ANTIQUOT ("", s) -> + (let x = Gram.Token.extract_string x in + let e = + AntiquotSyntax.parse_expr _loc s in + let match_fun = + Ast.ExFun (_loc, + Ast.McOr (_loc, + Ast.McArr (_loc, + Ast.PaApp (_loc, + Ast.PaId (_loc, + Ast.IdUid (_loc, x)), + Ast.PaId (_loc, + Ast.IdLid (_loc, "camlp4_x"))), + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdLid (_loc, "=")), + Ast.ExId (_loc, + Ast.IdLid (_loc, + "camlp4_x"))), + e), + Ast.ExId (_loc, + Ast.IdUid (_loc, "True"))), + Ast.McArr (_loc, Ast.PaAny _loc, + Ast.ExNil _loc, + Ast.ExId (_loc, + Ast.IdUid (_loc, "False"))))) in + let descr = "$" ^ (x ^ (" " ^ s)) in + let text = + TXtok (_loc, match_fun, descr) in + let p = + Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, x)), + Ast.PaTup (_loc, Ast.PaAny _loc)) + in + { + + used = []; + text = text; + styp = STtok _loc; + pattern = Some p; + } : + 'symbol) + | _ -> assert false))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")); + Gram.Stoken + (((function | STRING ((_)) -> true | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (s : Gram.Token.t) (x : Gram.Token.t) + (_loc : Loc.t) -> + (let s = Gram.Token.extract_string s in + let x = Gram.Token.extract_string x + in + mk_tok _loc + (Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, x)), + Ast.PaStr (_loc, s))) + (STtok _loc) : + 'symbol)))); + ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")) ], + (Gram.Action.mk + (fun (x : Gram.Token.t) (_loc : Loc.t) -> + (let x = Gram.Token.extract_string x + in + mk_tok _loc + (Ast.PaApp (_loc, + Ast.PaId (_loc, Ast.IdUid (_loc, x)), + Ast.PaTup (_loc, Ast.PaAny _loc))) + (STstring_tok _loc) : + 'symbol)))); + ([ Gram.Skeyword "`"; + Gram.Snterm + (Gram.Entry.obj (patt : 'patt Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'patt) _ (_loc : Loc.t) -> + (mk_tok _loc p (STtok _loc) : 'symbol)))); + ([ Gram.Skeyword "["; + Gram.Slist0sep + (Gram.Snterm + (Gram.Entry.obj (rule : 'rule Gram.Entry.t)), + Gram.Skeyword "|"); + Gram.Skeyword "]" ], + (Gram.Action.mk + (fun _ (rl : 'rule list) _ (_loc : Loc.t) -> + (let rl = + retype_rule_list_without_patterns _loc rl in + let t = new_type_var () + in + { + + used = used_of_rule_list rl; + text = + TXrules (_loc, srules _loc t rl ""); + styp = STquo (_loc, t); + pattern = None; + } : + 'symbol)))); + ([ Gram.Stoken + (((function + | UIDENT "NEXT" -> true + | _ -> false), + "UIDENT \"NEXT\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | UIDENT "NEXT" -> + ({ + + used = []; + text = TXnext _loc; + styp = STself (_loc, "NEXT"); + pattern = None; + } : 'symbol) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "SELF" -> true + | _ -> false), + "UIDENT \"SELF\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | UIDENT "SELF" -> + ({ + + used = []; + text = TXself _loc; + styp = STself (_loc, "SELF"); + pattern = None; + } : 'symbol) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (pattern : 'pattern Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ","; + Gram.Snterm + (Gram.Entry.obj + (comma_patt : 'comma_patt Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p2 : 'comma_patt) _ (p1 : 'pattern) _ + (_loc : Loc.t) -> + (Ast.PaTup (_loc, Ast.PaCom (_loc, p1, p2)) : + 'pattern)))); + ([ Gram.Skeyword "("; Gram.Sself; Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (p : 'pattern) _ (_loc : Loc.t) -> + (p : 'pattern)))); + ([ Gram.Skeyword "_" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> + (Ast.PaAny _loc : 'pattern)))); + ([ Gram.Stoken + (((function | LIDENT ((_)) -> true | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (i : Gram.Token.t) (_loc : Loc.t) -> + (let i = Gram.Token.extract_string i + in Ast.PaId (_loc, Ast.IdLid (_loc, i)) : + 'pattern)))) ]) ])) + ()); + Gram.extend (comma_patt : 'comma_patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (pattern : 'pattern Gram.Entry.t)) ], + (Gram.Action.mk + (fun (p : 'pattern) (_loc : Loc.t) -> + (p : 'comma_patt)))); + ([ Gram.Sself; Gram.Skeyword ","; Gram.Sself ], + (Gram.Action.mk + (fun (p2 : 'comma_patt) _ (p1 : 'comma_patt) + (_loc : Loc.t) -> + (Ast.PaCom (_loc, p1, p2) : 'comma_patt)))) ]) ])) + ()); + Gram.extend (name : 'name Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj (qualid : 'qualid Gram.Entry.t)) ], + (Gram.Action.mk + (fun (il : 'qualid) (_loc : Loc.t) -> + (mk_name _loc il : 'name)))) ]) ])) + ()); + Gram.extend (string : 'string Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | ANTIQUOT ("", _) -> true + | _ -> false), + "ANTIQUOT (\"\", _)")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | ANTIQUOT ("", s) -> + (AntiquotSyntax.parse_expr _loc s : + 'string) + | _ -> assert false))); + ([ Gram.Stoken + (((function | STRING ((_)) -> true | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (s : Gram.Token.t) (_loc : Loc.t) -> + (let s = Gram.Token.extract_string s + in Ast.ExStr (_loc, s) : 'string)))) ]) ])) + ()); + Gram.extend (semi_sep : 'semi_sep Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword ";" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'semi_sep)))) ]) ])) + ())) + let _ = + Gram.extend (symbol : 'symbol Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "top")), + [ (None, (Some Camlp4.Sig.Grammar.NonA), + [ ([ Gram.Stoken + (((function | UIDENT "SOPT" -> true | _ -> false), + "UIDENT \"SOPT\"")); + Gram.Sself ], + (Gram.Action.mk + (fun (s : 'symbol) (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "SOPT" -> (ssopt _loc s : 'symbol) + | _ -> assert false))); + ([ Gram.srules symbol + [ ([ Gram.Stoken + (((function + | UIDENT "SLIST1" -> true + | _ -> false), + "UIDENT \"SLIST1\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "SLIST1" -> (true : 'e__17) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "SLIST0" -> true + | _ -> false), + "UIDENT \"SLIST0\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "SLIST0" -> (false : 'e__17) + | _ -> assert false))) ]; + Gram.Sself; + Gram.Sopt + (Gram.srules symbol + [ ([ Gram.Stoken + (((function + | UIDENT "SEP" -> true + | _ -> false), + "UIDENT \"SEP\"")); + Gram.Snterm + (Gram.Entry.obj + (symbol : 'symbol Gram.Entry.t)) ], + (Gram.Action.mk + (fun (t : 'symbol) + (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "SEP" -> (t : 'e__18) + | _ -> assert false))) ]) ], + (Gram.Action.mk + (fun (sep : 'e__18 option) (s : 'symbol) + (min : 'e__17) (_loc : Loc.t) -> + (sslist _loc min sep s : 'symbol)))) ]) ])) + ()) + let sfold _loc n foldfun f e s = + let styp = STquo (_loc, new_type_var ()) in + let e = + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdLid (_loc, foldfun))), + f), + e) in + let t = + STapp (_loc, + STapp (_loc, + STtyp + (Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdLid (_loc, "fold"))), + Ast.TyAny _loc)), + s.styp), + styp) + in + { + + used = s.used; + text = TXmeta (_loc, n, [ s.text ], e, t); + styp = styp; + pattern = None; + } + let sfoldsep _loc n foldfun f e s sep = + let styp = STquo (_loc, new_type_var ()) in + let e = + Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdLid (_loc, foldfun))), + f), + e) in + let t = + STapp (_loc, + STapp (_loc, + STtyp + (Ast.TyApp (_loc, + Ast.TyId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, gm), + Ast.IdLid (_loc, "foldsep"))), + Ast.TyAny _loc)), + s.styp), + styp) + in + { + + used = s.used @ sep.used; + text = TXmeta (_loc, n, [ s.text; sep.text ], e, t); + styp = styp; + pattern = None; + } + let _ = + let _ = (symbol : 'symbol Gram.Entry.t) in + let grammar_entry_create = Gram.Entry.mk in + let simple_expr : 'simple_expr Gram.Entry.t = + grammar_entry_create "simple_expr" + in + (Gram.extend (symbol : 'symbol Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "top")), + [ (None, None, + [ ([ Gram.Stoken + (((function + | UIDENT "FOLD1" -> true + | _ -> false), + "UIDENT \"FOLD1\"")); + Gram.Snterm + (Gram.Entry.obj + (simple_expr : 'simple_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (simple_expr : 'simple_expr Gram.Entry.t)); + Gram.Sself; + Gram.Stoken + (((function | UIDENT "SEP" -> true | _ -> false), + "UIDENT \"SEP\"")); + Gram.Sself ], + (Gram.Action.mk + (fun (sep : 'symbol) (__camlp4_1 : Gram.Token.t) + (s : 'symbol) (e : 'simple_expr) + (f : 'simple_expr) + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match (__camlp4_1, __camlp4_0) with + | (UIDENT "SEP", UIDENT "FOLD1") -> + (sfoldsep _loc "FOLD1 SEP" "sfold1sep" f + e s sep : + 'symbol) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "FOLD0" -> true + | _ -> false), + "UIDENT \"FOLD0\"")); + Gram.Snterm + (Gram.Entry.obj + (simple_expr : 'simple_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (simple_expr : 'simple_expr Gram.Entry.t)); + Gram.Sself; + Gram.Stoken + (((function | UIDENT "SEP" -> true | _ -> false), + "UIDENT \"SEP\"")); + Gram.Sself ], + (Gram.Action.mk + (fun (sep : 'symbol) (__camlp4_1 : Gram.Token.t) + (s : 'symbol) (e : 'simple_expr) + (f : 'simple_expr) + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match (__camlp4_1, __camlp4_0) with + | (UIDENT "SEP", UIDENT "FOLD0") -> + (sfoldsep _loc "FOLD0 SEP" "sfold0sep" f + e s sep : + 'symbol) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "FOLD1" -> true + | _ -> false), + "UIDENT \"FOLD1\"")); + Gram.Snterm + (Gram.Entry.obj + (simple_expr : 'simple_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (simple_expr : 'simple_expr Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (s : 'symbol) (e : 'simple_expr) + (f : 'simple_expr) + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "FOLD1" -> + (sfold _loc "FOLD1" "sfold1" f e s : + 'symbol) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | UIDENT "FOLD0" -> true + | _ -> false), + "UIDENT \"FOLD0\"")); + Gram.Snterm + (Gram.Entry.obj + (simple_expr : 'simple_expr Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (simple_expr : 'simple_expr Gram.Entry.t)); + Gram.Sself ], + (Gram.Action.mk + (fun (s : 'symbol) (e : 'simple_expr) + (f : 'simple_expr) + (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT "FOLD0" -> + (sfold _loc "FOLD0" "sfold0" f e s : + 'symbol) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (simple_expr : 'simple_expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "("; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)); + Gram.Skeyword ")" ], + (Gram.Action.mk + (fun _ (e : 'expr) _ (_loc : Loc.t) -> + (e : 'simple_expr)))); + ([ Gram.Snterm + (Gram.Entry.obj + (a_LIDENT : 'a_LIDENT Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'a_LIDENT) (_loc : Loc.t) -> + (Ast.ExId (_loc, Ast.IdLid (_loc, i)) : + 'simple_expr)))) ]) ])) + ())) + let _ = + Options.add "-split_ext" (Arg.Set split_ext) + "Split EXTEND by functions to turn around a PowerPC problem." + let _ = + Options.add "-split_gext" (Arg.Set split_ext) + "Old name for the option -split_ext." + let _ = + Options.add "-meta_action" (Arg.Set meta_action) "Undocumented" + end + (* FIXME *) + module M = Register.OCamlSyntaxExtension(Id)(Make) + end +module M = + struct + open Camlp4 + (* -*- camlp4r -*- *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + module Id = + struct + let name = "Camlp4MacroParser" + let version = + "$Id: Macro.ml,v 1.2 2006/07/08 17:21:32 pouillar Exp $" + end + (* +Added statements: + + At toplevel (structure item): + + DEFINE <uident> + DEFINE <uident> = <expression> + DEFINE <uident> (<parameters>) = <expression> + IFDEF <uident> THEN <structure_items> (END | ENDIF) + IFDEF <uident> THEN <structure_items> ELSE <structure_items> (END | ENDIF) + IFNDEF <uident> THEN <structure_items> (END | ENDIF) + IFNDEF <uident> THEN <structure_items> ELSE <structure_items> (END | ENDIF) + INCLUDE <string> + + In expressions: + + IFDEF <uident> THEN <expression> ELSE <expression> (END | ENDIF) + IFNDEF <uident> THEN <expression> ELSE <expression> (END | ENDIF) + __FILE__ + __LOCATION__ + + In patterns: + + IFDEF <uident> THEN <pattern> ELSE <pattern> (END | ENDIF) + IFNDEF <uident> THEN <pattern> ELSE <pattern> (END | ENDIF) + + As Camlp4 options: + + -D<uident> define <uident> + -U<uident> undefine it + -I<dir> add <dir> to the search path for INCLUDE'd files + + After having used a DEFINE <uident> followed by "= <expression>", you + can use it in expressions *and* in patterns. If the expression defining + the macro cannot be used as a pattern, there is an error message if + it is used in a pattern. + + + + The toplevel statement INCLUDE <string> can be used to include a + file containing macro definitions and also any other toplevel items. + The included files are looked up in directories passed in via the -I + option, falling back to the current directory. + + The expression __FILE__ returns the current compiled file name. + The expression __LOCATION__ returns the current location of itself. + +*) + open Camlp4 + module Make (Syntax : Sig.Camlp4Syntax) = + struct + open Sig + include Syntax + type 'a item_or_def = + | SdStr of 'a | SdDef of string * ((string list) * Ast.expr) option + | SdUnd of string | SdITE of string * 'a * 'a | SdInc of string + let rec list_remove x = + function + | (y, _) :: l when y = x -> l + | d :: l -> d :: (list_remove x l) + | [] -> [] + let defined = ref [] + let is_defined i = List.mem_assoc i !defined + class reloc _loc = + object inherit Ast.map as super method _Loc_t = fun _ -> _loc end + class subst _loc env = + object inherit reloc _loc as super + method expr = + function + | (Ast.ExId (_, (Ast.IdLid (_, x))) | + Ast.ExId (_, (Ast.IdUid (_, x))) + as e) -> (try List.assoc x env with | Not_found -> e) + | e -> super#expr e + end + let bad_patt _loc = + Loc.raise _loc + (Failure + "this macro cannot be used in a pattern (see its definition)") + let substp _loc env = + let rec loop = + function + | Ast.ExApp (_, e1, e2) -> Ast.PaApp (_loc, loop e1, loop e2) + | Ast.ExId (_, (Ast.IdLid (_, x))) -> + (try List.assoc x env + with | Not_found -> Ast.PaId (_loc, Ast.IdLid (_loc, x))) + | Ast.ExId (_, (Ast.IdUid (_, x))) -> + (try List.assoc x env + with | Not_found -> Ast.PaId (_loc, Ast.IdUid (_loc, x))) + | Ast.ExInt (_, x) -> Ast.PaInt (_loc, x) + | Ast.ExStr (_, s) -> Ast.PaStr (_loc, s) + | Ast.ExTup (_, x) -> Ast.PaTup (_loc, loop x) + | Ast.ExCom (_, x1, x2) -> Ast.PaCom (_loc, loop x1, loop x2) + | Ast.ExRec (_, bi, (Ast.ExNil _)) -> + let rec substbi = + (function + | Ast.BiSem (_, b1, b2) -> + Ast.PaSem (_loc, substbi b1, substbi b2) + | Ast.BiEq (_, p, e) -> Ast.PaEq (_loc, p, loop e) + | _ -> bad_patt _loc) + in Ast.PaRec (_loc, substbi bi) + | _ -> bad_patt _loc + in loop + let incorrect_number loc l1 l2 = + Loc.raise loc + (Failure + (Printf.sprintf "expected %d parameters; found %d" + (List.length l2) (List.length l1))) + let define eo x = + ((match eo with + | Some (([], e)) -> + (Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "simple")), + [ (None, None, + [ ([ Gram.Stoken + (((function + | UIDENT camlp4_x when camlp4_x = x -> + true + | _ -> false), + "$UIDENT x")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT ((_)) -> + ((new reloc _loc)#expr e : 'expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (patt : 'patt Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "simple")), + [ (None, None, + [ ([ Gram.Stoken + (((function + | UIDENT camlp4_x when camlp4_x = x -> + true + | _ -> false), + "$UIDENT x")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT ((_)) -> + (let p = substp _loc [] e + in (new reloc _loc)#patt p : 'patt) + | _ -> assert false))) ]) ])) + ())) + | Some ((sl, e)) -> + (Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "apply")), + [ (None, None, + [ ([ Gram.Stoken + (((function + | UIDENT camlp4_x when camlp4_x = x -> + true + | _ -> false), + "$UIDENT x")); + Gram.Sself ], + (Gram.Action.mk + (fun (param : 'expr) + (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT ((_)) -> + (let el = + (match param with + | Ast.ExTup (_, e) -> + Ast.list_of_expr e [] + | e -> [ e ]) + in + if + (List.length el) = + (List.length sl) + then + (let env = List.combine sl el + in (new subst _loc env)#expr e) + else incorrect_number _loc el sl : + 'expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (patt : 'patt Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "simple")), + [ (None, None, + [ ([ Gram.Stoken + (((function + | UIDENT camlp4_x when camlp4_x = x -> + true + | _ -> false), + "$UIDENT x")); + Gram.Sself ], + (Gram.Action.mk + (fun (param : 'patt) + (__camlp4_0 : Gram.Token.t) + (_loc : Loc.t) -> + match __camlp4_0 with + | UIDENT ((_)) -> + (let pl = + (match param with + | Ast.PaTup (_, p) -> + Ast.list_of_patt p [] + | p -> [ p ]) + in + if + (List.length pl) = + (List.length sl) + then + (let env = List.combine sl pl in + let p = substp _loc env e + in (new reloc _loc)#patt p) + else incorrect_number _loc pl sl : + 'patt) + | _ -> assert false))) ]) ])) + ())) + | None -> ()); + defined := (x, eo) :: !defined) + let undef x = + try + let eo = List.assoc x !defined + in + ((match eo with + | Some (([], _)) -> + (Gram.delete_rule expr + [ Gram.Stoken + (((function + | UIDENT camlp4_x when camlp4_x = x -> true + | _ -> false), + "$UIDENT x")) ]; + Gram.delete_rule patt + [ Gram.Stoken + (((function + | UIDENT camlp4_x when camlp4_x = x -> true + | _ -> false), + "$UIDENT x")) ]) + | Some ((_, _)) -> + (Gram.delete_rule expr + [ Gram.Stoken + (((function + | UIDENT camlp4_x when camlp4_x = x -> true + | _ -> false), + "$UIDENT x")); + Gram.Sself ]; + Gram.delete_rule patt + [ Gram.Stoken + (((function + | UIDENT camlp4_x when camlp4_x = x -> true + | _ -> false), + "$UIDENT x")); + Gram.Sself ]) + | None -> ()); + defined := list_remove x !defined) + with | Not_found -> () + (* This is a list of directories to search for INCLUDE statements. *) + let include_dirs = ref [] + (* Add something to the above, make sure it ends with a slash. *) + let add_include_dir str = + if str <> "" + then + (let str = + if (String.get str ((String.length str) - 1)) = '/' + then str + else str ^ "/" + in include_dirs := !include_dirs @ [ str ]) + else () + let parse_include_file rule = + let dir_ok file dir = Sys.file_exists (dir ^ file) + in + fun file -> + let file = + try + (List.find (dir_ok file) (!include_dirs @ [ "./" ])) ^ file + with | Not_found -> file in + let ch = open_in file in + let st = Stream.of_channel ch + in Gram.parse rule (Loc.mk file) st + let _ = + let _ = (expr : 'expr Gram.Entry.t) + and _ = (sig_item : 'sig_item Gram.Entry.t) + and _ = (str_item : 'str_item Gram.Entry.t) + and _ = (patt : 'patt Gram.Entry.t) in + let grammar_entry_create = Gram.Entry.mk in + let endif : 'endif Gram.Entry.t = grammar_entry_create "endif" + and uident : 'uident Gram.Entry.t = grammar_entry_create "uident" + and opt_macro_value : 'opt_macro_value Gram.Entry.t = + grammar_entry_create "opt_macro_value" + in + (Gram.extend (str_item : 'str_item Gram.Entry.t) + ((fun () -> + ((Some Camlp4.Sig.Grammar.First), + [ (None, None, + [ ([ Gram.Skeyword "INCLUDE"; + Gram.Stoken + (((function | STRING ((_)) -> true | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (fname : Gram.Token.t) _ (_loc : Loc.t) -> + (let fname = Gram.Token.extract_string fname + in parse_include_file str_items fname : + 'str_item)))); + ([ Gram.Skeyword "IFNDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Skeyword "THEN"; + Gram.Snterm + (Gram.Entry.obj + (str_items : 'str_items Gram.Entry.t)); + Gram.Skeyword "ELSE"; + Gram.Snterm + (Gram.Entry.obj + (str_items : 'str_items Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (endif : 'endif Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (st2 : 'str_items) _ (st1 : 'str_items) _ + (i : 'uident) _ (_loc : Loc.t) -> + (if is_defined i then st2 else st1 : + 'str_item)))); + ([ Gram.Skeyword "IFNDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Skeyword "THEN"; + Gram.Snterm + (Gram.Entry.obj + (str_items : 'str_items Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (endif : 'endif Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (st : 'str_items) _ (i : 'uident) _ + (_loc : Loc.t) -> + (if is_defined i then Ast.StNil _loc else st : + 'str_item)))); + ([ Gram.Skeyword "IFDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Skeyword "THEN"; + Gram.Snterm + (Gram.Entry.obj + (str_items : 'str_items Gram.Entry.t)); + Gram.Skeyword "ELSE"; + Gram.Snterm + (Gram.Entry.obj + (str_items : 'str_items Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (endif : 'endif Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (st2 : 'str_items) _ (st1 : 'str_items) _ + (i : 'uident) _ (_loc : Loc.t) -> + (if is_defined i then st1 else st2 : + 'str_item)))); + ([ Gram.Skeyword "IFDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Skeyword "THEN"; + Gram.Snterm + (Gram.Entry.obj + (str_items : 'str_items Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj (endif : 'endif Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (st : 'str_items) _ (i : 'uident) _ + (_loc : Loc.t) -> + (if is_defined i then st else Ast.StNil _loc : + 'str_item)))); + ([ Gram.Skeyword "UNDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)) ], + (Gram.Action.mk + (fun (i : 'uident) _ (_loc : Loc.t) -> + ((undef i; Ast.StNil _loc) : 'str_item)))); + ([ Gram.Skeyword "DEFINE"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Snterm + (Gram.Entry.obj + (opt_macro_value : + 'opt_macro_value Gram.Entry.t)) ], + (Gram.Action.mk + (fun (def : 'opt_macro_value) (i : 'uident) _ + (_loc : Loc.t) -> + ((define def i; Ast.StNil _loc) : 'str_item)))) ]) ])) + ()); + Gram.extend (sig_item : 'sig_item Gram.Entry.t) + ((fun () -> + ((Some Camlp4.Sig.Grammar.First), + [ (None, None, + [ ([ Gram.Skeyword "INCLUDE"; + Gram.Stoken + (((function | STRING ((_)) -> true | _ -> false), + "STRING _")) ], + (Gram.Action.mk + (fun (fname : Gram.Token.t) _ (_loc : Loc.t) -> + (let fname = Gram.Token.extract_string fname + in parse_include_file sig_items fname : + 'sig_item)))) ]) ])) + ()); + Gram.extend (endif : 'endif Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "ENDIF" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'endif)))); + ([ Gram.Skeyword "END" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (() : 'endif)))) ]) ])) + ()); + Gram.extend (opt_macro_value : 'opt_macro_value Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([], + (Gram.Action.mk + (fun (_loc : Loc.t) -> (None : 'opt_macro_value)))); + ([ Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (Some (([], e)) : 'opt_macro_value)))); + ([ Gram.Skeyword "("; + Gram.Slist1sep + (Gram.srules opt_macro_value + [ ([ Gram.Stoken + (((function + | LIDENT ((_)) -> true + | _ -> false), + "LIDENT _")) ], + (Gram.Action.mk + (fun (x : Gram.Token.t) (_loc : Loc.t) + -> + (let x = + Gram.Token.extract_string x + in x : 'e__19)))) ], + Gram.Skeyword ","); + Gram.Skeyword ")"; Gram.Skeyword "="; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ _ (pl : 'e__19 list) _ + (_loc : Loc.t) -> + (Some ((pl, e)) : 'opt_macro_value)))) ]) ])) + ()); + Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "top")), + [ (None, None, + [ ([ Gram.Skeyword "IFNDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Skeyword "THEN"; Gram.Sself; + Gram.Skeyword "ELSE"; Gram.Sself; + Gram.Snterm + (Gram.Entry.obj (endif : 'endif Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (e2 : 'expr) _ (e1 : 'expr) _ + (i : 'uident) _ (_loc : Loc.t) -> + (if is_defined i then e2 else e1 : 'expr)))); + ([ Gram.Skeyword "IFDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Skeyword "THEN"; Gram.Sself; + Gram.Skeyword "ELSE"; Gram.Sself; + Gram.Snterm + (Gram.Entry.obj (endif : 'endif Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (e2 : 'expr) _ (e1 : 'expr) _ + (i : 'uident) _ (_loc : Loc.t) -> + (if is_defined i then e1 else e2 : 'expr)))) ]) ])) + ()); + Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + ((Some (Camlp4.Sig.Grammar.Level "simple")), + [ (None, None, + [ ([ Gram.Stoken + (((function + | LIDENT "__LOCATION__" -> true + | _ -> false), + "LIDENT \"__LOCATION__\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | LIDENT "__LOCATION__" -> + (let (a, b, c, d, e, f, g, h) = + Loc.to_tuple _loc + in + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, + Ast.IdUid (_loc, "Loc"), + Ast.IdLid (_loc, "of_tuple"))), + Ast.ExTup (_loc, + Ast.ExCom (_loc, + Ast.ExStr (_loc, + Ast.safe_string_escaped a), + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExCom (_loc, + Ast.ExInt (_loc, + string_of_int b), + Ast.ExInt (_loc, + string_of_int c)), + Ast.ExInt (_loc, + string_of_int d)), + Ast.ExInt (_loc, + string_of_int e)), + Ast.ExInt (_loc, + string_of_int f)), + Ast.ExInt (_loc, + string_of_int g)), + if h + then + Ast.ExId (_loc, + Ast.IdUid (_loc, "True")) + else + Ast.ExId (_loc, + Ast.IdUid (_loc, "False")))))) : + 'expr) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | LIDENT "__FILE__" -> true + | _ -> false), + "LIDENT \"__FILE__\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | LIDENT "__FILE__" -> + (Ast.ExStr (_loc, + Ast.safe_string_escaped + (Loc.file_name _loc)) : + 'expr) + | _ -> assert false))) ]) ])) + ()); + Gram.extend (patt : 'patt Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "IFNDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Skeyword "THEN"; Gram.Sself; + Gram.Skeyword "ELSE"; Gram.Sself; + Gram.Snterm + (Gram.Entry.obj (endif : 'endif Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (p2 : 'patt) _ (p1 : 'patt) _ + (i : 'uident) _ (_loc : Loc.t) -> + (if is_defined i then p2 else p1 : 'patt)))); + ([ Gram.Skeyword "IFDEF"; + Gram.Snterm + (Gram.Entry.obj (uident : 'uident Gram.Entry.t)); + Gram.Skeyword "THEN"; Gram.Sself; + Gram.Skeyword "ELSE"; Gram.Sself; + Gram.Snterm + (Gram.Entry.obj (endif : 'endif Gram.Entry.t)) ], + (Gram.Action.mk + (fun _ (p2 : 'patt) _ (p1 : 'patt) _ + (i : 'uident) _ (_loc : Loc.t) -> + (if is_defined i then p1 else p2 : 'patt)))) ]) ])) + ()); + Gram.extend (uident : 'uident Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function | UIDENT ((_)) -> true | _ -> false), + "UIDENT _")) ], + (Gram.Action.mk + (fun (i : Gram.Token.t) (_loc : Loc.t) -> + (let i = Gram.Token.extract_string i in i : + 'uident)))) ]) ])) + ())) + let _ = + Options.add "-D" (Arg.String (define None)) + "<string> Define for IFDEF instruction." + let _ = + Options.add "-U" (Arg.String undef) + "<string> Undefine for IFDEF instruction." + let _ = + Options.add "-I" (Arg.String add_include_dir) + "<string> Add a directory to INCLUDE search path." + end + let _ = let module M = Register.OCamlSyntaxExtension(Id)(Make) in () + end +module D = + struct + open Camlp4 + (* -*- camlp4r -*- *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Nicolas Pouillard: initial version + *) + module Id = + struct + let name = "Camlp4DebugParser" + let version = + "$Id: Debug.ml,v 1.2 2006/07/08 17:21:32 pouillar Exp $" + end + module Make (Syntax : Sig.Camlp4Syntax) = + struct + open Sig + include Syntax + module StringSet = Set.Make(String) + let debug_mode = + try + let str = Sys.getenv "STATIC_CAMLP4_DEBUG" in + let rec loop acc i = + try + let pos = String.index_from str i ':' + in + loop (StringSet.add (String.sub str i (pos - i)) acc) + (pos + 1) + with + | Not_found -> + StringSet.add (String.sub str i ((String.length str) - i)) + acc in + let sections = loop StringSet.empty 0 + in + if StringSet.mem "*" sections + then (fun _ -> true) + else (fun x -> StringSet.mem x sections) + with | Not_found -> (fun _ -> false) + let rec apply accu = + function + | [] -> accu + | x :: xs -> + let _loc = Ast.loc_of_expr x + in apply (Ast.ExApp (_loc, accu, x)) xs + let mk_debug_mode _loc = + function + | None -> + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Debug"), + Ast.IdLid (_loc, "mode"))) + | Some m -> + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, m), + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Debug"), + Ast.IdLid (_loc, "mode")))) + let mk_debug _loc m fmt section args = + let call = + apply + (Ast.ExApp (_loc, + Ast.ExApp (_loc, + Ast.ExId (_loc, + Ast.IdAcc (_loc, Ast.IdUid (_loc, "Debug"), + Ast.IdLid (_loc, "printf"))), + Ast.ExStr (_loc, section)), + Ast.ExStr (_loc, fmt))) + args + in + Ast.ExIfe (_loc, + Ast.ExApp (_loc, mk_debug_mode _loc m, + Ast.ExStr (_loc, section)), + call, Ast.ExId (_loc, Ast.IdUid (_loc, "()"))) + let _ = + let _ = (expr : 'expr Gram.Entry.t) in + let grammar_entry_create = Gram.Entry.mk in + let end_or_in : 'end_or_in Gram.Entry.t = + grammar_entry_create "end_or_in" + and start_debug : 'start_debug Gram.Entry.t = + grammar_entry_create "start_debug" + in + (Gram.extend (expr : 'expr Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Snterm + (Gram.Entry.obj + (start_debug : 'start_debug Gram.Entry.t)); + Gram.Stoken + (((function | LIDENT ((_)) -> true | _ -> false), + "LIDENT _")); + Gram.Stoken + (((function | STRING ((_)) -> true | _ -> false), + "STRING _")); + Gram.Slist0 + (Gram.Snterml + (Gram.Entry.obj (expr : 'expr Gram.Entry.t), + ".")); + Gram.Snterm + (Gram.Entry.obj + (end_or_in : 'end_or_in Gram.Entry.t)) ], + (Gram.Action.mk + (fun (x : 'end_or_in) (args : 'expr list) + (fmt : Gram.Token.t) (section : Gram.Token.t) + (m : 'start_debug) (_loc : Loc.t) -> + (let fmt = Gram.Token.extract_string fmt in + let section = + Gram.Token.extract_string section + in + match (x, (debug_mode section)) with + | (None, false) -> + Ast.ExId (_loc, + Ast.IdUid (_loc, "()")) + | (Some e, false) -> e + | (None, _) -> + mk_debug _loc m fmt section args + | (Some e, _) -> + Ast.ExLet (_loc, Ast.BFalse, + Ast.BiEq (_loc, + Ast.PaId (_loc, + Ast.IdUid (_loc, "()")), + mk_debug _loc m fmt section args), + e) : + 'expr)))) ]) ])) + ()); + Gram.extend (end_or_in : 'end_or_in Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Skeyword "in"; + Gram.Snterm + (Gram.Entry.obj (expr : 'expr Gram.Entry.t)) ], + (Gram.Action.mk + (fun (e : 'expr) _ (_loc : Loc.t) -> + (Some e : 'end_or_in)))); + ([ Gram.Skeyword "end" ], + (Gram.Action.mk + (fun _ (_loc : Loc.t) -> (None : 'end_or_in)))) ]) ])) + ()); + Gram.extend (start_debug : 'start_debug Gram.Entry.t) + ((fun () -> + (None, + [ (None, None, + [ ([ Gram.Stoken + (((function + | LIDENT "camlp4_debug" -> true + | _ -> false), + "LIDENT \"camlp4_debug\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | LIDENT "camlp4_debug" -> + (Some "Camlp4" : 'start_debug) + | _ -> assert false))); + ([ Gram.Stoken + (((function + | LIDENT "debug" -> true + | _ -> false), + "LIDENT \"debug\"")) ], + (Gram.Action.mk + (fun (__camlp4_0 : Gram.Token.t) (_loc : Loc.t) + -> + match __camlp4_0 with + | LIDENT "debug" -> (None : 'start_debug) + | _ -> assert false))) ]) ])) + ())) + end + let _ = let module M = Register.OCamlSyntaxExtension(Id)(Make) in () + end +module P = + struct + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Nicolas Pouillard: initial version + *) + let _ = Camlp4.Register.enable_dump_ocaml_ast_printer () + end +module B = + struct + (* camlp4r *) + (****************************************************************************) + (* *) + (* Objective Caml *) + (* *) + (* INRIA Rocquencourt *) + (* *) + (* Copyright 2006 Institut National de Recherche en Informatique et *) + (* en Automatique. All rights reserved. This file is distributed under *) + (* the terms of the GNU Library General Public License, with the special *) + (* exception on linking described in LICENSE at the top of the Objective *) + (* Caml source tree. *) + (* *) + (****************************************************************************) + (* Authors: + * - Daniel de Rauglaudre: initial version + * - Nicolas Pouillard: refactoring + *) + (* $Id: Camlp4Bin.ml,v 1.12 2006/10/02 12:58:59 ertai Exp $ *) + open Camlp4 + open PreCast.Syntax + open PreCast + open Format + module CleanAst = Camlp4.Struct.CleanAst.Make(Ast) + module SSet = Set.Make(String) + let pa_r = "Camlp4OCamlRevisedParser" + (* value pa_rr = "Camlp4OCamlrrParser"; *) + let pa_o = "Camlp4OCamlParser" + let pa_rp = "Camlp4OCamlRevisedParserParser" + let pa_op = "Camlp4OCamlParserParser" + let pa_g = "Camlp4GrammarParser" + let pa_m = "Camlp4MacroParser" + let pa_qb = "Camlp4QuotationCommon" + let pa_q = "Camlp4QuotationExpander" + let pa_rq = "Camlp4OCamlRevisedQuotationExpander" + let pa_oq = "Camlp4OCamlOriginalQuotationExpander" + let dyn_loader = + ref (fun _ -> raise (Match_failure ("./camlp4/Camlp4Bin.ml", 42, 24))) + let rcall_callback = ref (fun () -> ()) + let loaded_modules = ref SSet.empty + let add_to_loaded_modules name = + loaded_modules := SSet.add name !loaded_modules + let rewrite_and_load n x = + let dyn_loader = !dyn_loader () in + let find_in_path = DynLoader.find_in_path dyn_loader in + let real_load name = + (add_to_loaded_modules name; DynLoader.load dyn_loader name) in + let load = + List.iter + (fun n -> + if SSet.mem n !loaded_modules + then () + else + (add_to_loaded_modules n; + DynLoader.load dyn_loader (n ^ ".cmo"))) + in + ((match (n, (String.lowercase x)) with + | (("Parsers" | ""), + ("pa_r.cmo" | "r" | "ocamlr" | "ocamlrevised" | + "camlp4ocamlrevisedparser.cmo")) + -> load [ pa_r ] + | (* | ("Parsers"|"", "rr" | "OCamlrr") -> load [pa_r; pa_rr] *) + (("Parsers" | ""), + ("pa_o.cmo" | "o" | "ocaml" | "camlp4ocamlparser.cmo")) + -> load [ pa_r; pa_o ] + | (("Parsers" | ""), + ("pa_rp.cmo" | "rp" | "rparser" | + "camlp4ocamlrevisedparserparser.cmo")) + -> load [ pa_r; pa_o; pa_rp ] + | (("Parsers" | ""), + ("pa_op.cmo" | "op" | "parser" | "camlp4ocamlparserparser.cmo")) + -> load [ pa_r; pa_o; pa_rp; pa_op ] + | (("Parsers" | ""), + ("pa_extend.cmo" | "pa_extend_m.cmo" | "g" | "grammar" | + "camlp4grammarparser.cmo")) + -> load [ pa_r; pa_g ] + | (("Parsers" | ""), + ("pa_macro.cmo" | "m" | "macro" | "camlp4macroparser.cmo")) -> + load [ pa_r; pa_m ] + | (("Parsers" | ""), ("q" | "camlp4quotationexpander.cmo")) -> + load [ pa_r; pa_qb; pa_q ] + | (("Parsers" | ""), + ("q_MLast.cmo" | "rq" | + "camlp4ocamlrevisedquotationexpander.cmo")) + -> load [ pa_r; pa_qb; pa_rq ] + | (("Parsers" | ""), + ("oq" | "camlp4ocamloriginalquotationexpander.cmo")) -> + load [ pa_r; pa_o; pa_qb; pa_oq ] + | (("Parsers" | ""), "rf") -> + load [ pa_r; pa_rp; pa_qb; pa_q; pa_g; pa_m ] + | (("Parsers" | ""), "of") -> + load [ pa_r; pa_o; pa_rp; pa_op; pa_qb; pa_rq; pa_g; pa_m ] + | (("Filters" | ""), ("lift" | "camlp4astlifter.cmo")) -> + load [ "Camlp4AstLifter" ] + | (("Filters" | ""), ("exn" | "camlp4exceptiontracer.cmo")) -> + load [ "Camlp4ExceptionTracer" ] + | (("Filters" | ""), ("prof" | "camlp4profiler.cmo")) -> + load [ "Camlp4Profiler" ] + | (("Filters" | ""), ("map" | "camlp4mapgenerator.cmo")) -> + load [ "Camlp4MapGenerator" ] + | (("Filters" | ""), ("fold" | "camlp4foldgenerator.cmo")) -> + load [ "Camlp4FoldGenerator" ] + | (("Filters" | ""), ("meta" | "camlp4metagenerator.cmo")) -> + load [ "Camlp4MetaGenerator" ] + | (("Filters" | ""), ("trash" | "camlp4trashremover.cmo")) -> + load [ "Camlp4TrashRemover" ] + | (("Filters" | ""), ("striploc" | "camlp4locationstripper.cmo")) + -> load [ "Camlp4LocationStripper" ] + | (("Filters" | ""), ("tracer" | "camlp4tracer.cmo")) -> + load [ "Camlp4Tracer" ] + | (("Printers" | ""), + ("pr_r.cmo" | "r" | "ocamlr" | "camlp4ocamlrevisedprinter.cmo")) + -> Register.enable_ocamlr_printer () + | (* | ("Printers"|"", "rr" | "OCamlrr" | "Camlp4Printers/OCamlrr.cmo") -> *) + (* Register.enable_ocamlrr_printer () *) + (("Printers" | ""), + ("pr_o.cmo" | "o" | "ocaml" | "camlp4ocamlprinter.cmo")) + -> Register.enable_ocaml_printer () + | (("Printers" | ""), + ("pr_dump.cmo" | "p" | "dumpocaml" | "camlp4ocamlastdumper.cmo")) + -> Register.enable_dump_ocaml_ast_printer () + | (("Printers" | ""), ("d" | "dumpcamlp4" | "camlp4astdumper.cmo")) + -> Register.enable_dump_camlp4_ast_printer () + | (("Printers" | ""), ("a" | "auto" | "camlp4autoprinter.cmo")) -> + load [ "Camlp4AutoPrinter" ] + | _ -> + let y = "Camlp4" ^ (n ^ ("/" ^ (x ^ ".cmo"))) + in real_load (try find_in_path y with | Not_found -> x)); + !rcall_callback ()) + let print_warning = eprintf "%a:\n%s@." Loc.print + let rec parse_file dyn_loader name pa getdir = + let directive_handler = + Some + (fun ast -> + match getdir ast with + | Some x -> + (match x with + | (_, "load", s) -> (rewrite_and_load "" s; None) + | (_, "directory", s) -> + (DynLoader.include_dir dyn_loader s; None) + | (_, "use", s) -> Some (parse_file dyn_loader s pa getdir) + | (_, "default_quotation", s) -> + (Quotation.default := s; None) + | (loc, _, _) -> + Loc.raise loc (Stream.Error "bad directive")) + | None -> None) in + let loc = Loc.mk name + in + (Warning.current := print_warning; + let ic = if name = "-" then stdin else open_in_bin name in + let cs = Stream.of_channel ic in + let clear () = if name = "-" then () else close_in ic in + let phr = + try pa ?directive_handler loc cs with | x -> (clear (); raise x) + in (clear (); phr)) + let output_file = ref None + let process dyn_loader name pa pr clean fold_filters getdir = + let ast = parse_file dyn_loader name pa getdir in + let ast = fold_filters (fun t filter -> filter t) ast in + let ast = clean ast + in pr ?input_file: (Some name) ?output_file: !output_file ast + let gind = + function + | Ast.SgDir (loc, n, (Ast.ExStr (_, s))) -> Some ((loc, n, s)) + | _ -> None + let gimd = + function + | Ast.StDir (loc, n, (Ast.ExStr (_, s))) -> Some ((loc, n, s)) + | _ -> None + open Register + let process_intf dyn_loader name = + process dyn_loader name CurrentParser.parse_interf CurrentPrinter. + print_interf new CleanAst.clean_ast#sig_item AstFilters. + fold_interf_filters gind + let process_impl dyn_loader name = + process dyn_loader name CurrentParser.parse_implem CurrentPrinter. + print_implem new CleanAst.clean_ast#str_item AstFilters. + fold_implem_filters gimd + let just_print_the_version () = + (printf "%s@." Camlp4_config.version; exit 0) + let print_version () = + (eprintf "Camlp4 version %s@." Camlp4_config.version; exit 0) + let print_stdlib () = + (printf "%s@." Camlp4_config.camlp4_standard_library; exit 0) + let usage ini_sl ext_sl = + (eprintf + "\ +Usage: camlp4 [load-options] [--] [other-options] +Options: +<file>.ml Parse this implementation file +<file>.mli Parse this interface file +<file>.(cmo|cma) Load this module inside the Camlp4 core@."; + Options.print_usage_list ini_sl; + (* loop (ini_sl @ ext_sl) where rec loop = + fun + [ [(y, _, _) :: _] when y = "-help" -> () + | [_ :: sl] -> loop sl + | [] -> eprintf " -help Display this list of options.@." ]; *) + if ext_sl <> [] + then + (eprintf "Options added by loaded object files:@."; + Options.print_usage_list ext_sl) + else ()) + let warn_noassert () = + eprintf + "\ +camlp4 warning: option -noassert is obsolete +You should give the -noassert option to the ocaml compiler instead.@." + type file_kind = + | Intf of string | Impl of string | Str of string + | ModuleImpl of string | IncludeDir of string + let search_stdlib = ref true + let print_loaded_modules = ref false + let (task, do_task) = + let t = ref None in + let task f x = + let () = Camlp4_config.current_input_file := x + in + t := + Some + (if !t = None then (fun _ -> f x) else (fun usage -> usage ())) in + let do_task usage = match !t with | Some f -> f usage | None -> () + in (task, do_task) + let input_file x = + let dyn_loader = !dyn_loader () + in + (!rcall_callback (); + (match x with + | Intf file_name -> task (process_intf dyn_loader) file_name + | Impl file_name -> task (process_impl dyn_loader) file_name + | Str s -> + let (f, o) = Filename.open_temp_file "from_string" ".ml" + in + (output_string o s; + close_out o; + task (process_impl dyn_loader) f) + | ModuleImpl file_name -> rewrite_and_load "" file_name + | IncludeDir dir -> DynLoader.include_dir dyn_loader dir); + !rcall_callback ()) + let initial_spec_list = + [ ("-I", (Arg.String (fun x -> input_file (IncludeDir x))), + "<directory> Add directory in search patch for object files."); + ("-where", (Arg.Unit print_stdlib), + "Print camlp4 library directory and exit."); + ("-nolib", (Arg.Clear search_stdlib), + "No automatic search for object files in library directory."); + ("-intf", (Arg.String (fun x -> input_file (Intf x))), + "<file> Parse <file> as an interface, whatever its extension."); + ("-impl", (Arg.String (fun x -> input_file (Impl x))), + "<file> Parse <file> as an implementation, whatever its extension."); + ("-str", (Arg.String (fun x -> input_file (Str x))), + "<string> Parse <string> as an implementation."); + ("-unsafe", (Arg.Set Camlp4_config.unsafe), + "Generate unsafe accesses to array and strings."); + ("-noassert", (Arg.Unit warn_noassert), + "Obsolete, do not use this option."); + ("-verbose", (Arg.Set Camlp4_config.verbose), + "More verbose in parsing errors."); + ("-loc", (Arg.Set_string Loc.name), + ("<name> Name of the location variable (default: " ^ + (!Loc.name ^ ")."))); + ("-QD", (Arg.String (fun x -> Quotation.dump_file := Some x)), + "<file> Dump quotation expander result in case of syntax error."); + ("-o", (Arg.String (fun x -> output_file := Some x)), + "<file> Output on <file> instead of standard output."); + ("-v", (Arg.Unit print_version), "Print Camlp4 version and exit."); + ("-version", (Arg.Unit just_print_the_version), + "Print Camlp4 version number and exit."); + ("-no_quot", (Arg.Clear Camlp4_config.quotations), + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token."); + ("-loaded-modules", (Arg.Set print_loaded_modules), + "Print the list of loaded modules."); + ("-parser", (Arg.String (rewrite_and_load "Parsers")), + "<name> Load the parser Camlp4Parsers/<name>.cmo"); + ("-printer", (Arg.String (rewrite_and_load "Printers")), + "<name> Load the printer Camlp4Printers/<name>.cmo"); + ("-filter", (Arg.String (rewrite_and_load "Filters")), + "<name> Load the filter Camlp4Filters/<name>.cmo"); + ("-ignore", (Arg.String ignore), "ignore the next argument"); + ("--", (Arg.Unit ignore), "Deprecated, does nothing") ] + let _ = Options.init initial_spec_list + let anon_fun name = + input_file + (if Filename.check_suffix name ".mli" + then Intf name + else + if Filename.check_suffix name ".ml" + then Impl name + else + if Filename.check_suffix name ".cmo" + then ModuleImpl name + else + if Filename.check_suffix name ".cma" + then ModuleImpl name + else raise (Arg.Bad ("don't know what to do with " ^ name))) + let main argv = + let usage () = + (usage initial_spec_list (Options.ext_spec_list ()); exit 0) + in + try + let dynloader = + DynLoader.mk ~ocaml_stdlib: !search_stdlib + ~camlp4_stdlib: !search_stdlib () + in + (dyn_loader := (fun () -> dynloader); + let call_callback () = + Register.iter_and_take_callbacks + (fun (name, module_callback) -> + let () = add_to_loaded_modules name in module_callback ()) + in + (call_callback (); + rcall_callback := call_callback; + (match Options.parse anon_fun argv with + | [] -> () + | ("-help" | "--help" | "-h" | "-?") :: _ -> usage () + | s :: _ -> + (eprintf "%s: unknown or misused option\n" s; + eprintf "Use option -help for usage@."; + exit 2)); + do_task usage; + call_callback (); + if !print_loaded_modules + then SSet.iter (eprintf "%s@.") !loaded_modules + else ())) + with + | Arg.Bad s -> + (eprintf "Error: %s\n" s; + eprintf "Use option -help for usage@."; + exit 2) + | Arg.Help _ -> usage () + | exc -> (eprintf "@[<v0>%a@]@." ErrorHandler.print exc; exit 2) + let _ = main Sys.argv + end + diff --git a/camlp4/boot/camlp4boot.ml4 b/camlp4/boot/camlp4boot.ml4 new file mode 100644 index 000000000..582ce9c27 --- /dev/null +++ b/camlp4/boot/camlp4boot.ml4 @@ -0,0 +1,9 @@ +module R = struct INCLUDE "camlp4/Camlp4Parsers/Camlp4OCamlRevisedParser.ml"; end; +module Camlp4QuotationCommon = struct INCLUDE "camlp4/Camlp4Parsers/Camlp4QuotationCommon.ml"; end; +module Q = struct INCLUDE "camlp4/Camlp4Parsers/Camlp4QuotationExpander.ml"; end; +module Rp = struct INCLUDE "camlp4/Camlp4Parsers/Camlp4OCamlRevisedParserParser.ml"; end; +module G = struct INCLUDE "camlp4/Camlp4Parsers/Camlp4GrammarParser.ml"; end; +module M = struct INCLUDE "camlp4/Camlp4Parsers/Camlp4MacroParser.ml"; end; +module D = struct INCLUDE "camlp4/Camlp4Parsers/Camlp4DebugParser.ml"; end; +module P = struct INCLUDE "camlp4/Camlp4Printers/Camlp4OCamlAstDumper.ml"; end; +module B = struct INCLUDE "camlp4/Camlp4Bin.ml"; end; diff --git a/camlp4/build/YaM.ml b/camlp4/build/YaM.ml deleted file mode 100644 index a23a29ea5..000000000 --- a/camlp4/build/YaM.ml +++ /dev/null @@ -1,916 +0,0 @@ -(* - * - * Copyright (C) 2003-2004 Damien Pous - * - * YaM is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * YaM is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with YaM; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - * - *) - -open Printf - - -let print_deps = ref false -let print_cmds = ref true -let debug_status = ref false -let debug_deps = ref false -let debug_build = ref false - - -(* ---- Définition des unités de compilation ---- *) - -(* environnement / options *) -type options_t = { - ocaml: string ref; - ocamlc: string ref; - ocamlopt: string ref; - ocamldep: string ref; - ocamldoc: string ref; - ocamlyacc: string ref; - ocamllex: string ref; - ocamlglade: string ref; - ocaml_P4: string ref; - ocaml_P4_opt: string ref; - ocaml_Flags: string ref; - ocaml_OptFlags: string ref; - ocaml_ByteFlags: string ref; - ocaml_LinkFlags: string ref; - ocaml_ForPack: string ref; - ocaml_Includes: string list ref; - ocaml_ExtIncludes: string list ref; - ocaml_ExtLibraries: string list ref; -} - - -(* options par défaut *) -let getenv n d = try Sys.getenv n with Not_found -> d -let options = ref { - ocaml = ref (getenv "OCAML" "ocaml"); - ocamlc = ref (getenv "OCAMLC" "ocamlc.opt"); - ocamlopt = ref (getenv "OCAMLOPT" "ocamlopt.opt"); - ocamldep = ref (getenv "OCAMLDEP" "ocamldep.opt"); - ocamldoc = ref (getenv "OCAMLDOC" "ocamldoc.opt"); - ocamlyacc = ref (getenv "OCAMLYACC" "ocamlyacc"); - ocamllex = ref (getenv "OCAMLLEX" "ocamllex.opt"); - ocamlglade = ref (getenv "OCAMLGLADE" "lablgladecc2 -hide-default"); - ocaml_P4 = ref ""; - ocaml_P4_opt = ref ""; - ocaml_Flags = ref ""; - ocaml_OptFlags = ref ""; - ocaml_ByteFlags = ref ""; - ocaml_LinkFlags = ref ""; - ocaml_ForPack = ref ""; - ocaml_Includes = ref []; - ocaml_ExtIncludes = ref []; - ocaml_ExtLibraries = ref []; -} -let dir = ref "" - -(* calcul d'une valeur dans un nouvel environnement (options) *) -let new_scope v = - let options' = !options in - options := { - ocaml = ref !(options'.ocaml); - ocamlc = ref !(options'.ocamlc); - ocamlopt = ref !(options'.ocamlopt); - ocamldep = ref !(options'.ocamldep); - ocamldoc = ref !(options'.ocamldoc); - ocamlyacc = ref !(options'.ocamlyacc); - ocamllex = ref !(options'.ocamllex); - ocamlglade = ref !(options'.ocamlglade); - ocaml_P4 = ref !(options'.ocaml_P4); - ocaml_P4_opt = ref !(options'.ocaml_P4_opt); - ocaml_Flags = ref !(options'.ocaml_Flags); - ocaml_OptFlags = ref !(options'.ocaml_OptFlags); - ocaml_ByteFlags = ref !(options'.ocaml_ByteFlags); - ocaml_LinkFlags = ref !(options'.ocaml_LinkFlags); - ocaml_ForPack = ref !(options'.ocaml_ForPack); - ocaml_Includes = ref !(options'.ocaml_Includes); - ocaml_ExtIncludes = ref !(options'.ocaml_ExtIncludes); - ocaml_ExtLibraries = ref !(options'.ocaml_ExtLibraries); - }; - let v' = Lazy.force v in - options := options'; - v' - - -(* type (interne) des unités *) -type unit_t = { - - name: string; - - (* ensembles de fichiers : *) - sources: string list; (* sources *) - targets: string list; (* générés ET ciblés *) - pregenerated: string list; (* à créer avant de calculer des dépendances *) - trash: string list; (* générables "à nettoyer" *) - - (* cibles automatiques (quand aucune cible n'est spécifiée) *) - auto_targets: string list; - - (* éventuelles sous-unités *) - sub_units: unit_t list; - - (* objet généré (à lier) *) - objects: (string*string) option; (* natif / bytecode *) - - (* dépendances d'une cible f *) - dependencies: native: bool -> string -> string list; - - (* fichiers dont dépendent le résultat précédent *) - dep_files: string -> string list; - - (* commande pour la compilation d'une cible f - * renvoie (cmd, out) où - * - cmd est la commande à exécuter - * - out est l'ensemble des fichiers générés par cette commande - *) - compile_cmd: string -> string * string list; - -} - - - - -(* ---- Utilitaires ---- *) - - - -let (^=) r s = r := if !r="" then s else !r^" "^s -let (+=) l x = l := x :: !l -let (@=) l x = l := !l @ x -let (^^) s t = if t="" then s else if s="" then t else s^" "^t -let id x = x -let fcons f = fun x q -> f x::q -let rec rev_map_append f l1 l2 = match l1 with - | [] -> l2 - | x::q -> rev_map_append f q (f x::l2) -let string_of_list f = List.fold_left (fun acc x -> acc^^(f x)) "" -let flatten = List.fold_left (^^) "" -let select b = if b then fst else snd -let select_set b = if b then (fun (_,y) z -> z,y) else (fun (x,_) z -> x,z) -let rec print_inc = function - | [] -> "" - | x::q -> "-I "^x^^(print_inc q) -let print_p4 = function "" -> "" | s -> "-pp "^s -let oget x = function Some x -> x | _ -> x -let ofold f = List.fold_right (function Some o -> f o | _ -> id) -let omap f l = ofold (fcons f) l [] -let otfold f = List.fold_right (function {objects=Some o} -> f o | _ -> id) -let otmap f l = otfold (fcons f) l [] - -let mtime f = (Unix.stat f).Unix.st_mtime -let file_newer f1 f2 = not (Sys.file_exists f2) || mtime f1 > mtime f2 -let exists_file_newer f = - let mtf = mtime f in - List.exists (fun f' -> mtime f' > mtf) -let silent_remove f = try Sys.remove f with Sys_error _ -> () -let touch_file f = if not (Sys.file_exists f) then close_out (open_out f) - -exception CmdError of string - -let makecommand = - match Sys.os_type with - | "Win32" -> (fun cmd -> "bash -c " ^ Filename.quote cmd) - | _ -> (fun cmd -> cmd) - -let call cmd = Sys.command (makecommand cmd) -let ecall cmd = if (call cmd) <> 0 then raise (CmdError cmd) -let exitf ?(err=1) x = kprintf (fun msg -> eprintf "%s" msg; exit err) x - -let fileconcat dirname filename = - let l = String.length dirname in - if l = 0 || dirname.[l-1] = '/' - then dirname ^ filename - else dirname ^ "/" ^ filename - -let mk_ext e = (fun n -> n^e), (fun n -> Filename.check_suffix n e) -let ml , is_ml = mk_ext ".ml" -let mli , is_mli = mk_ext ".mli" -let mly , is_mly = mk_ext ".mly" -let mll , is_mll = mk_ext ".mll" -let glade, is_glade = mk_ext ".glade" -let cmo , is_cmo = mk_ext ".cmo" -let cmi , is_cmi = mk_ext ".cmi" -let cmx , is_cmx = mk_ext ".cmx" -let cma , is_cma = mk_ext ".cma" -let cmxa , is_cmxa = mk_ext ".cmxa" -let oo , is_o = mk_ext ".o" -let aa , is_a = mk_ext ".a" -let cc , is_c = mk_ext ".c" -let run , is_run = mk_ext ".run" -let opt , is_opt = mk_ext ".opt" -let annot, is_annot = mk_ext ".annot" - -let rec iter_units f = function - | [] -> () - | u::q -> f u; iter_units f u.sub_units; iter_units f q - -let rec fold_units f a = function - | [] -> a - | u::q -> fold_units f (f u (fold_units f a u.sub_units)) q - -let get_line c = - let rec get accu = - let s = input_line c in - let l = String.length s in - if l > 0 && s.[l-1] = '\\' - then get (String.sub s 0 (l-1) :: accu) - else if l > 1 && s.[l-1] = '\r' && s.[l-2] = '\\' - then get (String.sub s 0 (l-2) :: accu) - else String.concat "" (List.rev (s :: accu)) - in get [] - -let split_string pred s = - let rec split1 i accu = - if i >= String.length s - then List.rev accu - else if pred s.[i] then split1 (i+1) accu - else split2 i (i+1) accu - and split2 i j accu = - if j >= String.length s - then List.rev (String.sub s i (j-i) :: accu) - else if pred s.[j] then split1 (j+1) (String.sub s i (j-i) :: accu) - else split2 i (j+1) accu - in split1 0 [] - -(* ---- Outils OCaml (c,dep,opt...) ---- *) - - -(* parsing de la sortie d'ocamldep *) -let tokenize ?(skip=false) c = - try - if skip then ignore (get_line c); - match split_string (function ' ' | ':' -> true | _ -> false) - (get_line c) with - | [] -> [] - | _ :: deps -> deps - with End_of_file -> [] - -let ocamldep ~native ~depc ~sf = - let nat = if native then "-native " else "" in - let cmd = depc^^"-slash"^^nat^^sf in - if !print_deps then printf "%s\n%!" cmd - else printf "DEPENDENCIES: %s\n%!" sf; - let c_in = Unix.open_process_in (makecommand cmd) in - let deps = tokenize ~skip:(native && is_ml sf) c_in in - let deps' = - if native then deps - else List.map (fun f -> if is_cmo f then cmi (Filename.chop_extension f) else f) deps - in - ignore (Unix.close_process_in c_in); - sf::deps' - -let ocamldepi ~native ~depc ~f ~n = - ocamldep ~native ~depc ~sf:(if is_cmi f then mli n else ml n) - -let ocamlobj ~bytec ~optc ~f ~n = - (select (is_cmx f) (optc, bytec))^" -c "^(ml n), [f; cmi n] - -let ocamlobji ~bytec ~optc ~impl_flags ~f ~n = - if is_cmi f then bytec^" -c "^(mli n), [f] - else (select (is_cmx f) (optc, bytec))^^impl_flags^^"-c"^^(ml n), [f] - -let for_pack o = if !(o.ocaml_ForPack) = "" then "" - else "-for-pack" ^^ !(o.ocaml_ForPack) - -let ocaml_options ?(o= !options) ?(flags="") ?(byte_flags="") ?(opt_flags="") ?pp ?(includes=[]) ?(ext_includes=[]) n = - let flags' = (print_inc !(o.ocaml_Includes))^^(print_inc includes)^^(print_p4 (oget !(o.ocaml_P4) pp)) in - let depc = !(o.ocamldep)^^flags' in - let flags' = !(o.ocaml_Flags)^^flags^^(print_inc !(o.ocaml_ExtIncludes))^^(print_inc ext_includes)^^flags' in - let bytec = !(o.ocamlc) ^^flags'^^byte_flags^^ !(o.ocaml_ByteFlags) in - let opt_flags' = (print_inc !(o.ocaml_Includes))^^(print_inc includes)^^(print_p4 (oget !(o.ocaml_P4_opt) pp)) in - let opt_flags' = !(o.ocaml_Flags)^^flags^^(print_inc !(o.ocaml_ExtIncludes))^^(print_inc ext_includes)^^opt_flags' in - let optc = !(o.ocamlopt)^^(for_pack o)^^opt_flags'^^opt_flags ^^ !(o.ocaml_OptFlags) in - (fileconcat !dir n), depc, bytec, optc - - - -(* fabrication générique d'unités *) -let generic_unit - ~name ?(sources=[]) ~targets ?(trash=targets) ?(auto_targets=[]) ?(sub_units=[]) ?(pregenerated=[]) - ?objects ~dependencies ?(dep_files=fun _->[]) ~compile_cmd () - = - { name=name; sources=sources; targets=targets; objects=objects; - trash=trash; auto_targets=auto_targets; sub_units=sub_units; pregenerated=pregenerated; - dependencies=dependencies; compile_cmd=compile_cmd; dep_files=dep_files; - } - - - - -(* ----- Différents types d'unités ----- *) - - -(* module ocaml, sans interface *) -let ocaml_Module ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n = - let n, depc, bytec, optc = - ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n - in - let ml_n, cmo_n, cmi_n, cmx_n = ml n, cmo n, cmi n, cmx n in - let targets = [cmo_n; cmi_n; cmx_n] in - generic_unit - ~name:n - ~sources:[ml_n] ~targets ~trash:(oo n :: annot n :: targets) ~objects:(cmx_n, cmo_n) - ~dependencies:(fun ~native f -> if is_cmi f then [select native (cmx_n, cmo_n)] - else ocamldep ~native ~depc ~sf:(ml_n)) - ~compile_cmd: (fun f -> ocamlobj ~bytec ~optc ~f ~n) - ~dep_files: (fun f -> if is_cmi f then [] else [ml_n]) - () - -let generic_ocaml_Module_extension extension command = - fun ?o ?flags ?byte_flags - ?opt_flags ?(cmd_flags="") - ?pp ?includes ?ext_includes ?trash n -> - let n', depc, _, _ = - ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n - in - let ext_n, ml_n = n'^extension, n'^".ml" in - let cmd = command cmd_flags ext_n ml_n in - generic_unit - ~name:n - ~sources:[ext_n] ~targets:[ml_n] ?trash - ~objects:(n'^".cmx", n'^".cmo") ~pregenerated:[ml_n] - ~sub_units:[ocaml_Module ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n] - ~dependencies:(fun ~native f -> [ext_n]) - (* ~dependencies:(fun ~native f -> ocamldep ~native ~depc ~sf:(ext_n)) *) - ~compile_cmd: (fun f -> cmd, [f]) - () - - -(* module ocaml, avec interface *) -let ocaml_IModule ?o ?flags ?byte_flags ?opt_flags ?(impl_flags = "") ?pp ?includes ?ext_includes n = - let n, depc, bytec, optc = - ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n - in - let ml_n, mli_n, cmo_n, cmi_n, cmx_n = ml n, mli n, cmo n, cmi n, cmx n in - let targets = [cmo_n; cmi_n; cmx_n] in - generic_unit - ~name:n - ~sources:[ml_n; mli_n] ~targets ~trash:(oo n :: annot n :: targets) ~objects:(cmx_n, cmo_n) - ~dependencies:(fun ~native f -> ocamldepi ~native ~depc ~f ~n) - ~compile_cmd: (fun f -> ocamlobji ~bytec ~impl_flags ~optc ~f ~n) - ~dep_files: (fun f -> if is_cmi f then [mli_n] else [ml_n]) - () - -(* Comme ocaml_IModule sauf que la commande de construction n'est pas - * appelee et que les fichiers ne sont pas detruit par clean. - * en gros compile_cmd ne fait rien et trash = []. *) -let ocaml_fake_IModule ?o ?flags ?byte_flags ?opt_flags ?(impl_flags = "") ?pp ?includes ?ext_includes n = - let n, depc, bytec, optc = - ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n - in - let ml_n, mli_n, cmo_n, cmi_n, cmx_n = ml n, mli n, cmo n, cmi n, cmx n in - let targets = [cmo_n; cmi_n; cmx_n] in - generic_unit - ~name:n - ~sources:[ml_n; mli_n] ~targets ~trash:[] ~objects:(cmx_n, cmo_n) - ~dependencies:(fun ~native f -> ocamldepi ~native ~depc ~f ~n) - ~compile_cmd:(fun _ -> "", []) - ~dep_files: (fun f -> if is_cmi f then [mli_n] else [ml_n]) - () - - -(* interface ocaml pure *) -let ocaml_Interface ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n = - let n, depc, bytec, optc = - ocaml_options ?o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n - in - let mli_n, cmi_n = mli n, cmi n in - let targets = [cmi_n] in - generic_unit - ~name:n - ~sources:[mli_n] ~targets ~trash:(annot n :: targets) - ~dependencies:(fun ~native f -> ocamldep ~native ~depc ~sf:mli_n) - ~compile_cmd: (fun f -> bytec^" -c "^(mli_n), [f]) - ~dep_files: (fun f -> [mli_n]) - () - - -(* objet C *) -let c_Module ?(o= !options) ?(flags="") ?(source_deps=[]) n = - let n = fileconcat !dir n in - let sources = List.map (fileconcat !dir) source_deps in - let c_n, o_n = cc n, oo n in - let cc = !(o.ocamlc)^" -c"^^flags^^c_n in - let sources = c_n::sources in - generic_unit - ~name:n - ~sources ~targets:[o_n] - ~dependencies:(fun ~native f -> sources) - ~objects:(o_n,o_n) - ~compile_cmd: (fun f -> cc, [f]) - () - - -(* lexer ocaml *) -let ocaml_Lexer ?(o= !options) ?flags ?byte_flags ?opt_flags ?(lex_flags="") ?pp ?includes ?ext_includes n = - let n' = fileconcat !dir n in - let mll_n, ml_n = mll n', ml n' in - let ocamllex = !(o.ocamllex)^^lex_flags^^mll_n in - generic_unit - ~name:n - ~sources:[mll_n] ~targets:[ml_n] - ~objects:(cmx n', cmo n') ~pregenerated:[ml_n] - ~sub_units:[ocaml_Module ~o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n] - ~dependencies:(fun ~native f -> [mll_n]) - ~compile_cmd: (fun f -> ocamllex, [f]) - () - - -(* parser ocaml *) -let ocaml_Parser ?(o= !options) ?flags ?byte_flags ?opt_flags ?(yacc_flags="") ?pp ?includes ?ext_includes n = - let n' = fileconcat !dir n in - let mly_n, ml_n, mli_n = mly n', ml n', mli n' in - let ocamlyacc = !(o.ocamlyacc)^^yacc_flags^^mly_n in - let gen = [ml_n; mli_n] in - generic_unit - ~name:n - ~sources:[mly_n] ~targets:gen ~trash:((n'^".output") :: gen) - ~objects:(cmx n', cmo n') ~pregenerated:gen - ~sub_units:[ocaml_IModule ~o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n] - ~dependencies:(fun ~native f -> [mly_n] ) - ~compile_cmd: (fun f -> ocamlyacc, gen) - () - - -(* interface glade à compiler en ocaml *) -let ocaml_Glade ?(o= !options) ?flags ?byte_flags ?opt_flags ?(glade_flags="") ?pp ?includes ?ext_includes n = - let n' = fileconcat !dir n in - let glade_n, ml_n = glade n', ml n' in - let ocamlglade = !(o.ocamlglade)^^glade_flags^^glade_n^" > "^ml_n in - generic_unit - ~name:n - ~sources:[glade_n] ~targets:[ml_n] - ~objects:(cmx n', cmo n') ~pregenerated:[ml_n] - ~sub_units:[ocaml_Module ~o ?flags ?byte_flags ?opt_flags ?pp ?includes ?ext_includes n] - ~dependencies:(fun ~native f -> [glade_n]) - ~compile_cmd: (fun f -> ocamlglade, [f]) - () - - -(* paquet de modules ocaml *) -let ocaml_Package ?(o= !options) n sub_units = - let n = fileconcat !dir n in - let ml_n, cmo_n, cmi_n, cmx_n, o_n = ml n, cmo n, cmi n, cmx n, oo n in - let otmap2 f = List.fold_right - (function { objects=None; targets=[x] } - when is_cmi x - && Sys.file_exists (mli (Filename.chop_extension x)) - -> (fun accu -> x :: accu) - | { objects=Some x } -> fcons f x - | _ -> id) sub_units [] in - let objs, sobjs = - let x = otmap2 fst in - let y = otmap2 snd in - let sx = flatten x in - let sy = flatten y in - (x, y), (sx, sy) - in - let targets = [cmo_n; cmi_n; cmx_n] in - generic_unit - ~name:n - ~targets ~objects:(cmx_n, cmo_n) ~trash:(ml_n::o_n::targets) ~pregenerated:[ml_n] ~sub_units - ~dependencies:(fun ~native f -> - if is_cmi f then [select native (cmx_n, cmo_n)] - else - select native objs - ) - ~compile_cmd: (fun f -> - if is_cmx f then !(o.ocamlopt)^^(for_pack o)^^"-I"^^n^^"-pack -o"^^f^^(fst sobjs), [cmx_n; cmi_n] - else !(o.ocamlc)^^"-pack -o"^^cmo_n^^(snd sobjs), [cmo_n; cmi_n]) - () - -let add_for_pack o n = - if !(o.ocaml_ForPack) = "" then o.ocaml_ForPack := n - else o.ocaml_ForPack := !(o.ocaml_ForPack)^"."^n - -(* paquet de modules regroupés dans un sous répertoire *) -let ocaml_PackageDir ?o n l = - let n' = fileconcat !dir n in - let dir' = !dir in - dir := fileconcat n' ""; - let l' = new_scope (lazy (!options.ocaml_Includes += n'; - add_for_pack !options n; Lazy.force l)) in - dir := dir'; - ocaml_Package ?o n l' - - -(* librairie ocaml *) -let ocaml_Library ?(o= !options) ?flags ?byte_flags ?opt_flags ?includes ?(libraries=[]) ?(default=`Byte) n sub_units = - let n, depc, bytec, optc = - ocaml_options ~o ?flags ?byte_flags ?opt_flags ?includes n - in - let objs b = - let scma = select b (cmxa, cma) in - (* (map scma extlib) @ (map scma libs) @ (otmap (select b) sub_units) *) - List.rev_append - (rev_map_append scma - libraries - (List.rev_map scma !(o.ocaml_ExtLibraries)) - ) - (otmap (select b) sub_units) - in - let objs, sobjs = - let x, y = objs true, objs false in - let sx = flatten x in - let sy = flatten y in - (x,y), (sx,sy) - in - let cma_n, cmxa_n, a_n = cma n, cmxa n, aa n in - generic_unit - ~name:n - ~targets:[cma_n; cmxa_n] ~trash:[a_n] ~objects:(cmxa_n, cma_n) ~sub_units - ~auto_targets:[if default=`Byte; then cma_n else cmxa_n] - ~dependencies:(fun ~native f -> select (is_cmxa f) objs) - ~compile_cmd: (fun f -> - if is_cmxa f then optc ^" -a -o "^f^^(fst sobjs), [f] - else bytec^" -a -o "^f^^(snd sobjs), [f]) - () - - -(* exécutable ocaml *) -let ocaml_Program ?(o= !options) ?flags ?byte_flags ?opt_flags ?includes ?(libraries=[]) ?(default=`Byte) n sub_units = - let n, depc, bytec, optc = - ocaml_options ~o ?flags ?byte_flags ?opt_flags ?includes n - in - let objs b = - let scma = select b (cmxa, cma) in - (* (map scma extlib) @ (map scma libs) @ (otmap (select b) sub_units) *) - List.rev_append - (rev_map_append scma - libraries - (List.rev_map scma !(o.ocaml_ExtLibraries)) - ) - (otmap (select b) sub_units) - in - let objs, sobjs = - let x, y = objs true, objs false in - let sx = flatten x in - let sy = flatten y in - (x,y), (sx,sy) - in - let run_n, opt_n = run n, opt n in - generic_unit - ~name:n - ~targets:[run_n; opt_n] ~sub_units - ~auto_targets:[if default=`Byte; then run_n else opt_n] - ~dependencies:(fun ~native f -> select (is_opt f) objs) - ~compile_cmd: (fun f -> - if is_opt f then optc ^" -o "^f^^(fst sobjs), [f] - else bytec^" -o "^f^^(snd sobjs), [f]) - () - - -(* cible silencieuse *) -let phony_unit ?(depends=["@FORCE@"]) ?(command="") name = - generic_unit ~targets:[name] - ~name - ~trash:[] - ~dependencies:(fun ~native f -> depends) - ~compile_cmd: (fun _ -> command,[]) - () - -let fold_units_sources units f = - let rec fold units accu = - List.fold_left (fun accu u -> f u.name u.sources (fold u.sub_units) accu) accu units - in fold units - -(* (\* unité utilisateur *\) *) -(* let user_unit ?trash ~command ~depends name = *) -(* let targets = [fileconcat !dir name] in *) -(* let trash = oget targets trash in *) -(* generic_unit ~targets ~trash *) -(* ~dependencies:(fun ~native _ -> depends) *) -(* ~compile_cmd: command *) -(* () *) - - - -(* récupération des fichiers sources OCaml *) -let ocaml_sources = - let rec crev_append l1 l2 = match l1 with - | [] -> l2 - | x::q when is_ml x || is_mli x -> crev_append q (x::l2) - | x::q -> crev_append q l2 - in - fold_units (fun u -> crev_append u.sources) [] - - - - -(* ---- Statuts des fichiers ---- *) - - - -(* statut d'un fichier *) -type status_t = { - mutable modified: int; (* dernière fois que l'on a _réellement_ été modifié *) - mutable updated: int; (* date de la dernière mise à jour *) - mutable mtime: float; (* mtime lors de la dernière mise à jour *) - mutable digest: Digest.t; (* digest lors de la dernière mise à jour *) - mutable cmd: Digest.t; (* digest de la commande utiliséee lors de la dernière mise à jour *) - mutable depended: int*int; (* date du dernier calcul des dépendances (mode natif et non natif) *) - mutable deps: string list*string list; (* listes des dépendances *) -} - -let make_status ~t ~f = - { modified = if Sys.file_exists f then t else 0; updated = 0; - depended = -1,-1; mtime = 0.0; digest = Digest.string "$*%"; - deps = [],[]; cmd = Digest.string "%*$" } - -let update_status ?cmdd ~t ~f st = - if !debug_status then printf "UPDATE (%s) : " f; - if Sys.file_exists f then - (if st.updated < t then ( - st.updated <- t; - (match cmdd with Some d -> st.cmd <- d | None -> ()); - let mt = mtime f in - if mt > st.mtime then ( - st.mtime <- mt; - let d = Digest.file f in - if st.digest <> d then ( - st.digest <- d; - if !debug_status then printf "modified"; - st.modified <- t - ) - ) - ) - ) else st.updated <- 0; - if !debug_status then printf "\n" - - -(* s1 plus récent que s2 *) -let (>>) s1 s2 = s1.modified > s2.updated - - - - - -(* ---- Gestion des projets ---- *) - -(* type des "projets" *) -type project_t = { - units: unit_t list; (* liste des unités *) - get_unit: string -> unit_t; (* obtention de l'unité correspondant à une cible *) - date: int; (* date courante *) - get_status: string -> status_t; (* statut d'un fichier *) - write_cache: unit -> unit; (* sauvegarde du cache des statuts *) -} -exception NoRuleFor of string - - -(* un fichier donné est-il une cible *) -let is_target p = fun f -> try ignore (p.get_unit f); true with _ -> false - - -(* récupération des fichiers sources *) -let sources_of_project p = - let rec crev_append l1 l2 = match l1 with - | [] -> l2 - | x::q when is_target p x -> crev_append q l2 - | x::q -> crev_append q (x::l2) - in - fold_units (fun u -> crev_append u.sources) [] p.units - - - - -(* alias pour le type des expressions mises en cache *) -type status_ct = int * (string, status_t) Hashtbl.t -let st_cache = ".cache-status" - -(* création d'un projet *) -let project ?(rebuild="ocaml build.ml") ?(deps=["Makefile.ml"]) units = - - (* mise à jour éventuelle de YaM *) - let () = if exists_file_newer Sys.executable_name deps then ( - let rebuild = ref rebuild in - for i=1 to Array.length Sys.argv -1 do rebuild := !rebuild^" "^Filename.quote Sys.argv.(i) done; - printf "yam is out-dated, rebuilding it (%s)\n%!" !rebuild; - exit (call !rebuild) - ) in - - (* construction de la table cible -> unités *) - let get_unit = - let table = Hashtbl.create 23 in - iter_units (fun u -> - List.iter - (fun t -> Hashtbl.add table t u) - u.targets - ) units; - (fun x -> try Hashtbl.find table x with Not_found -> raise (NoRuleFor x)) - in - - (* récupération des statuts *) - let date, get_status, write_cache = - let get_status (d,gt) = - let t = d-1 in - (fun f -> - try Hashtbl.find gt f - with Not_found -> - let s = make_status ~t ~f in - Hashtbl.add gt f s; - s - ) - in - let write_cache v = - (fun () -> - let c_out = open_out_bin st_cache in - output_value c_out (v: status_ct); - close_out c_out - ) - in - let get ((d,_) as v) = d, get_status v, write_cache v in - if Sys.file_exists st_cache then - let c_in = open_in_bin st_cache in - let d,gt = (input_value c_in: status_ct) in - close_in c_in; - get (d+1, gt) - else - get (1, Hashtbl.create 50) - in - - { units=units; get_unit=get_unit; date=date; - get_status=get_status; write_cache=write_cache } - - -(* nettoyage d'un projet *) -let clean p = - silent_remove st_cache; - iter_units (fun u -> List.iter silent_remove u.trash) p.units - -let genclean p out = - let trash = - fold_units (fun u -> List.fold_right (fun x acc -> x :: acc) u.trash) - [] p.units in - let out = open_out out in - Format.fprintf (Format.formatter_of_out_channel out) - "CLEANFILES = \\\n %s@." (String.concat " \\\n " trash); - close_out out - -(* (\* génération de la documentation *\) *) -(* let doc p = *) -(* let cmd = *) -(* let rec crev_append l1 l2 = match l1 with *) -(* | [] -> l2 *) -(* | x::q when is_ml x || is_mli x && not (is_target p x) -> crev_append q (l2^^x) *) -(* | x::q -> crev_append q l2 *) -(* in *) -(* fold_units (fun u -> crev_append u.sources) !(!options.ocamldoc) p.units *) -(* in *) -(* if !print_cmds then printf "%s\n%!" cmd; *) -(* ecall cmd *) - - -(* ---- Compilation ---- *) - - -(* compilation d'un projet (ou d'une de ses cibles) *) -let build ?target p = - - let date = p.date in - let get_status = p.get_status in - let get_unit = p.get_unit in - (* FIXME unused let is_target = is_target p in *) - - (* compilation d'une cible *) - let compile u f stf (cmd,cmdd,out) = - if cmd <> "" then if !print_cmds then printf "%s\n%!" cmd - else printf "COMPILE: %s\n%!" f; - ecall cmd; - List.iter (fun f -> update_status ~cmdd ~t:date ~f (get_status f)) out - in - - (* calcul de la liste des dépendances de f d'unité u et de statut st *) - let rec dependencies ~native f u st = - let stf = get_status f in - List.iter (fun sf -> - try ignore(get_unit sf); build ~native [sf] - with NoRuleFor _ -> update_status ~t:date ~f:sf (get_status sf) - ) u.sources; - if !debug_deps then printf "DEP: `%s' -> " f; - let l = u.dep_files f in - let ddate = select native stf.depended in - let recent df = (get_status df).modified > ddate in - if l=[] || List.exists recent l then - let deps = u.dependencies ~native f in - stf.deps <- select_set native stf.deps deps; - stf.depended <- select_set native stf.depended date; - if !debug_deps then printf "[%s]\n" (flatten deps); - deps - else ( - if !debug_deps then printf "cached [%s]\n" (flatten (select native stf.deps)); - select native stf.deps - ) - - (* compilation par continuations d'une pile de cibles *) - and build ?(native=false) ?(k=fun ()->()) = function - | [] -> k() - | f::q -> - let stf = get_status f in - if stf.updated < date then ( - if !debug_build then printf "BUILD: `%s'\n" f; - let u = get_unit f in - let native = native || is_cmx f || is_opt f || is_cmxa f in - let cmd, out = u.compile_cmd f in - let deps = dependencies ~native f u stf in - let deps' = List.filter (fun f -> try ignore(get_unit f); true with NoRuleFor _ -> false) deps in - let cmdd = Digest.string cmd in - let k' () = - if stf.cmd <> cmdd || - List.exists (fun f' -> get_status f' >> stf) deps - then compile u f stf (cmd,cmdd,out) - else update_status ~cmdd ~t:date ~f stf; - build ~native ~k q - in - build ~native ~k:k' deps' - ) else - build ~native ~k q - in - - (* ensemble des cibles à compiler *) - let targets = match target with - | Some t -> [t] - | _ -> List.fold_left (fun acc u -> List.rev_append u.auto_targets acc) [] p.units - in - - (* pré-génération des fichiers nécessaires au calcul des dépendances *) - iter_units (fun u -> List.iter touch_file u.pregenerated) p.units; - - (* compilation des cibles *) - try build ~k:p.write_cache targets with - | CmdError _ -> p.write_cache(); exit 1 - | NoRuleFor t -> eprintf "No rule to build `%s'\n" t; p.write_cache(); exit 1 - - - -(* ---- Point d'entrée par défaut ---- *) - -let main ?rebuild ?deps l = - let p = project ?rebuild ?deps l in - let cwd() = Sys.chdir (Filename.dirname Sys.executable_name) in - let targets = ref [] in - let main = ref (fun () -> - match !targets with - | [] -> build p - | l -> List.iter (fun target -> build ~target p) (List.rev l) - ) - in - let alone s = - if !targets <> [] || !Arg.current <> Array.length Sys.argv - 1 - then Printf.eprintf "Warning: `%s' specified, other arguments are ignored.\n" s - in - let version() = alone "-version"; Printf.printf "YaM version 1.0\n"; exit 0 in - let clean() = alone "-clean"; clean p; exit 0 in - let genclean s = genclean p s; exit 0 in - let verbosity s = - match s with - | ""|"0" -> print_cmds := false - | _ -> print_deps := true in - Arg.parse [ - "-version", Arg.Unit version, " \tdisplay version information"; - "-clean", Arg.Unit clean, " \tremove all generated files"; - "-genclean",Arg.String genclean, " \tgenerate a clean file list in the given file"; - "-v", Arg.Set print_deps, " \t\tbe verbose: print dependencies commands"; - "-q", Arg.Clear print_cmds, " \t\tbe quiet: do not print commands"; - "-r", Arg.String Sys.chdir, " <dir>\tset `dir' as root directory"; - "-R", Arg.Unit cwd, " \t\tset directory of YaM as root directory"; - - "-verbosity", Arg.String verbosity, " \tset the verbosity level: 0, 1, 2..."; - - "-db", Arg.Set debug_build, " \tdebug build"; - "-dd", Arg.Set debug_deps, " \tdebug deps"; - "-ds", Arg.Set debug_status, " \tdebug status"; - - ] ((+=) targets) "usage: yam {-version, -clean, [options] [targets...]}"; - !main () - -let rec best = - function - | [_, x] -> x - | (f, x) :: xs -> if Sys.file_exists f then x else best xs - | [] -> invalid_arg "YaM.best: []" - -let scall cmd = - let cin = Unix.open_process_in (makecommand cmd) in - let str = input_line cin in str - -let which x = scall ("which"^^x) - -let is_file_empty f = - let i = open_in f in - let res = in_channel_length i < 1 in - close_in i; res - diff --git a/camlp4/build/YaM.mli b/camlp4/build/YaM.mli deleted file mode 100644 index f24fa287e..000000000 --- a/camlp4/build/YaM.mli +++ /dev/null @@ -1,309 +0,0 @@ -(* - * - * Copyright (C) 2003-2004 Damien Pous - * - * YaM is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * YaM is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with YaM; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - * - *) - - -(** - -@author Damien Pous, (<a href="mailto:Damien.Pous_AT_ens-lyon.fr"><small>Damien.Pous_AT_ens-lyon.fr</small></a>) -@version 1.0 - -*) - - -(** {6 Environment / options} *) - -type options_t = { - ocaml: string ref; (** OCaml interpreter *) - ocamlc: string ref; (** OCaml compiler *) - ocamlopt: string ref; (** OCaml native compiler *) - ocamldep: string ref; (** OCaml dependencies generator *) - ocamldoc: string ref; (** OCaml documentation generator *) - ocamlyacc: string ref; (** OCaml parser generator *) - ocamllex: string ref; (** OCaml lexer generator *) - ocamlglade: string ref; (** OCaml glade compiler *) - ocaml_P4: string ref; (** Preprocessor to use *) - ocaml_P4_opt: string ref; (** Preprocessor to use `ocamlopt -c` *) - ocaml_Flags: string ref; (** Flags (c, byte, native and link modes) *) - ocaml_OptFlags: string ref; (** Flags for `ocamlopt -c' *) - ocaml_ByteFlags: string ref; (** Flags for `ocamlc -c' *) - ocaml_LinkFlags: string ref; (** Flags for linking *) - ocaml_ForPack: string ref; - ocaml_Includes: string list ref; (** Directories to include (with dependencies) *) - ocaml_ExtIncludes: string list ref; (** External directories to include (without dependencies) *) - ocaml_ExtLibraries: string list ref; (** External Libraries to use *) -} -(** The type of environments. *) - -val options: options_t ref -(** The current environment. - -Initial compiler names (ocamlc, ocamldep...) are taken in the environment (OCAMLC, OCAMLDEP...), -or defaults to standard values ("ocamlc", "ocamldep"...). - -Initial flags are empty. -*) - -val new_scope: 'a Lazy.t -> 'a -(** Forcing of a lazy value inside a `fresh' environment. *) - - - -(** {6 Compilation units} - -The way to specify environment and flags is redundant: - - the [?o] argument defaults to the current environment ([!options]). - - the other optional arguments are merged with this value. -*) - - -type unit_t -(** The type of compilation units. *) - - -val ocaml_Module: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> - ?pp: string -> ?includes: string list -> ?ext_includes: string list -> - string -> unit_t -(** Creates a compilation unit for a single, non interfaced OCaml module. *) - -val ocaml_IModule: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> - ?impl_flags: string -> - ?pp: string -> ?includes: string list -> ?ext_includes: string list -> - string -> unit_t -(** Creates a compilation unit for an OCaml module, with its interface. *) - -val ocaml_Interface: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> - ?pp: string -> ?includes: string list -> ?ext_includes: string list -> - string -> unit_t -(** Creates a compilation unit for a pure OCaml interface. *) - -val c_Module: - ?o: options_t -> ?flags: string -> ?source_deps: string list -> - string -> unit_t -(** Creates a compilation unit for a C module. - - [source_deps] are the additional source dependencies. -*) - -val ocaml_Lexer: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> ?lex_flags: string -> - ?pp: string -> ?includes: string list -> ?ext_includes: string list -> - string -> unit_t -(** Creates a compilation unit for an OCaml lexer. *) - -val ocaml_Parser: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> ?yacc_flags: string -> - ?pp: string -> ?includes: string list -> ?ext_includes: string list -> - string -> unit_t -(** Creates a compilation unit for an OCaml parser. *) - -val ocaml_Glade: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> ?glade_flags: string -> - ?pp: string -> ?includes: string list -> ?ext_includes: string list -> - string -> unit_t -(** Creates a compilation unit for an OCaml glade GUI. *) - -val ocaml_Package: - ?o: options_t -> - string -> unit_t list -> unit_t -(** Creates a compilation unit for an OCaml `package'. - - The objects defined by the given list of units are packed together, - using the `-pack' OCaml option. -*) - -val ocaml_PackageDir: - ?o: options_t -> - string -> unit_t list Lazy.t -> unit_t -(** Like {!YaM.ocaml_Package}, but assumes that all the files reside in a directory. - - [ocaml_PackageDir name list] will add the `-I name' flag, and prepend each filename inside - `list' with `name/'. -*) - -val ocaml_Library: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> - ?includes: string list -> ?libraries: string list -> - ?default: [`Native | `Byte] -> - string -> unit_t list -> unit_t -(** Creates a compilation unit for an OCaml Library. *) - -val ocaml_Program: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> - ?includes: string list -> ?libraries: string list -> - ?default: [`Native | `Byte] -> - string -> unit_t list -> unit_t -(** Creates a compilation unit for an OCaml Program. *) - -val generic_ocaml_Module_extension: - string -> - (string -> string -> string -> string) -> - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> - ?cmd_flags: string -> - ?pp: string -> ?includes: string list -> ?ext_includes: string list -> - ?trash: string list -> - string -> unit_t -(** Creates a compilation unit for a single, non interfaced OCaml module. *) - -val ocaml_fake_IModule: - ?o: options_t -> - ?flags: string -> ?byte_flags: string -> ?opt_flags: string -> - ?impl_flags: string -> - ?pp: string -> ?includes: string list -> ?ext_includes: string list -> - string -> unit_t -(** Creates a fake compilation unit for an OCaml module, with its interface. - Comme ocaml_IModule sauf que la commande de construction n'est pas - appelee et que les fichiers ne sont pas detruit par clean. - en gros compile_cmd ne fait rien et trash = []. *) - -val phony_unit: ?depends: string list -> ?command: string -> string -> unit_t -(** creates a phony unit which depends on [depends], and is built with [command]. *) - - -val fold_units_sources : unit_t list -> (string -> string list -> ('a -> 'a) -> 'a -> 'a) -> 'a -> 'a - - -(** {6 Entry point} *) - -val main: ?rebuild: string -> ?deps: string list -> unit_t list -> unit -(** default entry point (command line parsing). - -- [rebuild] is the command to use in order to compile YaM whenever `Makefile.ml' changed. -(defaults to "ocaml build.ml") - -- [deps] is the set of files YaM depends on. -(defaults to ["Makefile.ml"]) -*) - - - -(** {6 Lower level functions} *) - - -type project_t -(** The abstract type of projects. *) - -val project: - ?rebuild: string -> - ?deps: string list -> - unit_t list - -> project_t -(** Creates a project using the given list of units. - -- [rebuild] is the command to use in order to compile YaM whenever `Makefile.ml' changed. -(defaults to "ocaml build.ml") - -- [deps] is the set of files YaM depends on. -(defaults to ["Makefile.ml"]) -*) - -val print_deps: bool ref -(** Controls wether to print dependencies commands. *) - -val print_cmds: bool ref -(** Controls wether to print commands. *) - -val build: ?target:string -> project_t -> unit -(** Build the specified target, or the whole project if not specified. *) - -val clean: project_t -> unit -(** Clean all targets reachable from the project. *) - -val sources_of_project: project_t -> string list -(** Return all the source files of the project *) - - -val dir: string ref -(** The current directory. (used by ocaml_PackageDir) *) - -val generic_unit: - name: string -> - ?sources: string list -> targets: string list -> ?trash: string list -> ?auto_targets: string list -> - ?sub_units: unit_t list -> ?pregenerated: string list -> ?objects: (string*string) -> - dependencies: (native: bool -> string -> string list) -> - ?dep_files: (string -> string list) -> - compile_cmd: (string -> string * string list) -> - unit -> unit_t -(** Creates a generic unit. - - [sources] is the set of source files - - [targets] is the set of targets handled by the unit - - [trash] is the set of trash files generated by the unit - - [auto_targets] is the subset of targets whose building is done, when YaM is called without arguments - - [sub_units] is a set of "encapsulated" units - - [pregenerated] is a set of file to "pre-create" automatically if they don't exists (useful for generated sources files and ocamldep) - - [objects] are the objects to link when building an OCaml package/library/program. It is a pair since linking can be done - either in native mode or bytecode mode : [(nat_obj, byte_obj)]. - - [dependencies ~native target] must list the files [target] depends on, in mode specified by [native]. - - [dep_files target] are the files the previous call depends on (for dependencies caching). - - [compile_cmd target] must return a couple [(cmd,out)], where [cmd] is the command to use for building [target], and [out] is - the list of files that this command may create or modify. - -Default values are : - - [sources = auto_targets = sub_units = pregenerated = []] - - [trash = targets] - - [objects = None] (no object to link) - - [depfiles = (fun _ -> [])] (no caching) - -When using this function with inside [ocaml_PackageDir], you must set the current directory, -using [Filename.concat !dir]. -*) - - - -(** {6 Simple facilities} *) - -val (^^) : string -> string -> string -(** Concatenates two strings, inserting a space when nessesary. *) - -val (^=) : string ref -> string -> unit -(** Adds a string to the beginning of a string ref using {!YaM.(^^)}. *) - -val (+=) : 'a list ref -> 'a -> unit -(** Head insertion. *) - -val (@=) : 'a list ref -> 'a list -> unit -(** Tail insertion. *) - -val string_of_list: ('a -> string) -> 'a list -> string -(** Prints a list into a string, using {!YaM.(^^)}. *) - -val flatten: string list -> string -(** Flatten a string list, using using {!YaM.(^^)}. *) - -val best: (string * string) list -> string - -val getenv: string -> string -> string - -val which : string -> string - -val is_file_empty : string -> bool - -val call : string -> int diff --git a/camlp4/build/build.ml b/camlp4/build/build.ml deleted file mode 100644 index 408771427..000000000 --- a/camlp4/build/build.ml +++ /dev/null @@ -1,81 +0,0 @@ -(* ------------------------------------------------- * - to build your project, edit this settings, - and run `ocaml build.ml' - * ------------------------------------------------- *) - -(* Makefile to use *) -let makefile = "Makefile.ml" - -(* Environment options *) -let unixlib = - match Sys.os_type with - | "Win32" -> "../otherlibs/win32unix" - | _ -> "../otherlibs/unix" - -let ocamlrun = - Filename.concat Filename.parent_dir_name (Filename.concat "boot" "ocamlrun") - ^ " -I " ^ unixlib - -let ocamlc = ocamlrun ^ " ../ocamlc -g -nostdlib -I ../stdlib -I " ^ unixlib -let ocamlopt = ocamlrun ^ " ../ocamlopt -nostdlib -I ../stdlib -I " ^ unixlib -let yam = ocamlrun ^ " ./yam " - -(* Compile YaM in native mode ? *) -let opt = false - -(* Arguments to YaM *) -let yam_args = "-verbosity " ^ (try Sys.getenv "VERBOSE" with Not_found -> "0") - -(* ------------------------------------------------- *) - - - - - - - - - - - -open Printf -#load "unix.cma" - -let obj = if opt then "cmx" else "cmo" -let abj = if opt then "cmxa" else "cma" -let ocamlc = if opt then ocamlopt else ocamlc - -let mtime f = (Unix.stat f).Unix.st_mtime -let newer f1 f2 = not (Sys.file_exists f2) || mtime f1 > mtime f2 -let command c = - printf "%s\n%!" c; - match Sys.command c with - | 0 -> printf "[done], you can now use YaM directly !\n%!" - | n -> printf "[error], aborting...\n"; exit n -let ocamlc s = kprintf (fun cmd -> command (ocamlc^" "^cmd)) s - - -(* nettoyage *) -let () = if Array.length Sys.argv > 1 && Sys.argv.(1)="-cleanall" then ( - let safe_remove f = try Sys.remove f with _ -> () in - ignore (Sys.command (yam ^ "-clean")); - List.iter safe_remove [ - "Makefile.cmo"; "Makefile.cmx"; "Makefile.o"; "Makefile.cmi"; - "build/YaM.cmo"; "build/YaM.cmx"; "build/YaM.o"; "build/YaM.cmi"; "yam" - ]; - exit 0 -) - -(* mise à jour de YaM *) -let () = - if newer "build/YaM.mli" "build/YaM.cmi" then ocamlc "-o yam unix.%s -I build build/YaM.mli build/YaM.ml build/camlp4_config.ml %s" abj makefile - else if newer "build/YaM.ml" ("build/YaM."^obj) then ocamlc "-o yam unix.%s -I build build/YaM.ml build/camlp4_config.ml %s" abj makefile - else if newer makefile "yam" then ocamlc "-o yam unix.%s -I build build/YaM.%s build/camlp4_config.ml %s" abj obj makefile - -(* lancement de YaM *) -let cmd = - let cmd = ref (yam^yam_args) in - for i=1 to Array.length Sys.argv -1 do cmd := !cmd^" "^Sys.argv.(i) done; - !cmd - -let () = exit (Sys.command cmd) diff --git a/camlp4/build/compile-state b/camlp4/build/compile-state deleted file mode 100755 index 3582ea9bc..000000000 --- a/camlp4/build/compile-state +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/env ruby - -require 'pathname' -require 'fileutils' - -case ARGV[0] -when /r(estore)?/ - Pathname.new('.').find do |path| - next unless path.to_s =~ /^(.*)\.bootstrap$/ - FileUtils.cp(path, $1) - end -when /s(ave)?/ - Pathname.new('.').find do |path| - next unless path.to_s =~ /\.(cm([oia]|x|xa|)|o|a|run|opt|cache-status)$/ - FileUtils.cp(path, path.to_s + '.bootstrap') - end -else - STDERR.puts "Usage: #$0 ( r(estore)? | s(ave)? )" - exit 1 -end diff --git a/camlp4/camlp4prof.ml b/camlp4/camlp4prof.ml index 26123873a..7e9df17f7 100644 --- a/camlp4/camlp4prof.ml +++ b/camlp4/camlp4prof.ml @@ -1,9 +1,24 @@ -open Camlp4Profiler; +module Debug = struct value mode _ = False; end; -value profile = load stdin; +value count = + let h = Hashtbl.create 1007 in + let () = at_exit (fun () -> + let assoc = Hashtbl.fold (fun k v a -> [ (k, v.val) :: a ]) h [] in + let out = open_out "camlp4_profiler.out" in + let () = Marshal.to_channel out assoc [] in + close_out out) in + fun s -> + try incr (Hashtbl.find h s) + with [ Not_found -> Hashtbl.add h s (ref 1) ]; -value profile = List.sort (fun (_, v1) (_, v2) -> compare v1 v2) profile; +value load = Marshal.from_channel; -List.iter - (fun (k, v) -> Format.printf "%-75s: %d@." k v) - profile; +value main () = + + let profile = List.sort (fun (_, v1) (_, v2) -> compare v1 v2) (load stdin) in + + List.iter + (fun (k, v) -> Format.printf "%-75s: %d@." k v) + profile; + +if Sys.argv.(0) = "camlp4prof" then main () else (); diff --git a/camlp4/Camlp4Profiler.mli b/camlp4/camlp4prof.mli index 0703ac03c..0703ac03c 100644 --- a/camlp4/Camlp4Profiler.mli +++ b/camlp4/camlp4prof.mli diff --git a/camlp4/mkcamlp4.ml b/camlp4/mkcamlp4.ml index 997de4a56..ca19dd70f 100644 --- a/camlp4/mkcamlp4.ml +++ b/camlp4/mkcamlp4.ml @@ -19,7 +19,8 @@ (* $Id$ *) -open Camlp4.Config; +open Camlp4; +open Camlp4_config; open Filename; open Format; diff --git a/camlp4/test/fixtures/macrotest.ml b/camlp4/test/fixtures/macrotest.ml new file mode 100644 index 000000000..555457349 --- /dev/null +++ b/camlp4/test/fixtures/macrotest.ml @@ -0,0 +1,55 @@ +DEFINE A = 42; +DEFINE B = 51; + +IFDEF A THEN + value a_should_be_present = B + 2; + print_int (a_should_be_present + 1); +ENDIF; + +print_int (a_should_be_present + 2); + +IFNDEF C THEN + print_int (a_should_be_present + 3); +ENDIF; + +IFNDEF C THEN + print_int (a_should_be_present + 4); +ELSE + print_int (c_should_not_be_present + 1); +ENDIF; + +IFDEF C THEN + print_int (c_should_not_be_present + 2); +ELSIF + print_int (A * a_should_be_present + 5); +ENDIF; + +IFDEF DNE THEN + print_int (c_should_not_be_present + 2); +ELSIF + print_int (A * a_should_be_present + 5); +ENDIF; + +IFDEF OPT THEN + print_int (c_should_not_be_present + 2); +ELSIF + print_int (A * a_should_be_present + 5); +ENDIF; + +value e = + IFDEF DNE THEN + print_int (c_should_not_be_present + 2) + ELSE + print_int (A * a_should_be_present + 5) + ENDIF; + +value f = + fun _ -> + IFDEF DNE THEN + print_int (c_should_not_be_present + 2) + ELSE + print_int (A * a_should_be_present + 5) + ENDIF; + + +pouet; |