diff options
| -rw-r--r-- | camlp4/Camlp4/Sig/Camlp4Ast.ml | 83 | ||||
| -rw-r--r-- | camlp4/Camlp4Filters/GenerateFold.ml | 2 | ||||
| -rw-r--r-- | camlp4/Camlp4Filters/GenerateMap.ml | 2 | ||||
| -rw-r--r-- | camlp4/Camlp4Filters/LiftCamlp4Ast.ml | 8 | ||||
| -rw-r--r-- | camlp4/Camlp4Parsers/Grammar.ml | 6 | ||||
| -rw-r--r-- | camlp4/Camlp4Parsers/OCamlQuotationBase.ml | 50 | ||||
| -rw-r--r-- | camlp4/Makefile.ml | 11 |
7 files changed, 119 insertions, 43 deletions
diff --git a/camlp4/Camlp4/Sig/Camlp4Ast.ml b/camlp4/Camlp4/Sig/Camlp4Ast.ml index 4cded2689..427420a26 100644 --- a/camlp4/Camlp4/Sig/Camlp4Ast.ml +++ b/camlp4/Camlp4/Sig/Camlp4Ast.ml @@ -385,6 +385,89 @@ module type S = sig value loc_of_match_case : match_case -> Loc.t; value loc_of_ident : ident -> Loc.t; + module Meta : sig + 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 -> 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 -> expr; + end; + module MetaLoc : sig + value meta_loc_patt : Loc.t -> Loc.t -> patt; + value meta_loc_expr : Loc.t -> Loc.t -> expr; + end; + module MetaGhostLoc : sig + value meta_loc_patt : Loc.t -> 'a -> patt; + value meta_loc_expr : Loc.t -> 'a -> expr; + end; + module MetaLocVar : sig + value meta_loc_patt : Loc.t -> 'a -> patt; + value meta_loc_expr : Loc.t -> 'a -> expr; + end; + module Make (MetaLoc : META_LOC) : sig + module Expr : sig + value meta_string : Loc.t -> string -> expr; + value meta_int : Loc.t -> string -> expr; + value meta_float : Loc.t -> string -> expr; + value meta_char : Loc.t -> string -> expr; + value meta_bool : Loc.t -> bool -> expr; + value meta_list : (Loc.t -> 'a -> expr) -> Loc.t -> list 'a -> expr; + value meta_binding : Loc.t -> binding -> expr; + value meta_class_expr : Loc.t -> class_expr -> expr; + value meta_class_sig_item : Loc.t -> class_sig_item -> expr; + value meta_class_str_item : Loc.t -> class_str_item -> expr; + value meta_class_type : Loc.t -> class_type -> expr; + value meta_ctyp : Loc.t -> ctyp -> expr; + value meta_expr : Loc.t -> expr -> expr; + value meta_ident : Loc.t -> ident -> expr; + value meta_match_case : Loc.t -> match_case -> expr; + value meta_meta_bool : Loc.t -> meta_bool -> expr; + value meta_meta_option : + (Loc.t -> ident -> expr) -> + Loc.t -> meta_option ident -> expr; + value meta_module_binding : Loc.t -> module_binding -> expr; + value meta_module_expr : Loc.t -> module_expr -> expr; + value meta_module_type : Loc.t -> module_type -> expr; + value meta_patt : Loc.t -> patt -> expr; + value meta_sig_item : Loc.t -> sig_item -> expr; + value meta_str_item : Loc.t -> str_item -> expr; + value meta_with_constr : Loc.t -> with_constr -> expr; + end; + module Patt : sig + value meta_string : Loc.t -> string -> patt; + value meta_int : Loc.t -> string -> patt; + value meta_float : Loc.t -> string -> patt; + value meta_char : Loc.t -> string -> patt; + value meta_bool : Loc.t -> bool -> patt; + value meta_list : (Loc.t -> 'a -> patt) -> Loc.t -> list 'a -> patt; + value meta_binding : Loc.t -> binding -> patt; + value meta_class_expr : Loc.t -> class_expr -> patt; + value meta_class_sig_item : Loc.t -> class_sig_item -> patt; + value meta_class_str_item : Loc.t -> class_str_item -> patt; + value meta_class_type : Loc.t -> class_type -> patt; + value meta_ctyp : Loc.t -> ctyp -> patt; + value meta_expr : Loc.t -> expr -> patt; + value meta_ident : Loc.t -> ident -> patt; + value meta_match_case : Loc.t -> match_case -> patt; + value meta_meta_bool : Loc.t -> meta_bool -> patt; + value meta_meta_option : + (Loc.t -> ident -> patt) -> + Loc.t -> meta_option ident -> patt; + value meta_module_binding : Loc.t -> module_binding -> patt; + value meta_module_expr : Loc.t -> module_expr -> patt; + value meta_module_type : Loc.t -> module_type -> patt; + value meta_patt : Loc.t -> patt -> patt; + value meta_sig_item : Loc.t -> sig_item -> patt; + value meta_str_item : Loc.t -> str_item -> patt; + value meta_with_constr : Loc.t -> with_constr -> patt; + end; + end; + end; + (** See {!Ast.S.map}. *) class map : object inherit Mapper.c; diff --git a/camlp4/Camlp4Filters/GenerateFold.ml b/camlp4/Camlp4Filters/GenerateFold.ml index 2787ee04c..377eeb11a 100644 --- a/camlp4/Camlp4Filters/GenerateFold.ml +++ b/camlp4/Camlp4Filters/GenerateFold.ml @@ -28,8 +28,6 @@ end; module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct open AstFilters; module StringMap = Map.Make String; - module MetaLoc = Camlp4.Struct.MetaAst.MetaGhostLoc Ast; - module MetaAst = Camlp4.Struct.MetaAst.Make MetaLoc; open Ast; value _loc = Loc.ghost; diff --git a/camlp4/Camlp4Filters/GenerateMap.ml b/camlp4/Camlp4Filters/GenerateMap.ml index 51f88a679..09dc0159f 100644 --- a/camlp4/Camlp4Filters/GenerateMap.ml +++ b/camlp4/Camlp4Filters/GenerateMap.ml @@ -28,8 +28,6 @@ end; module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct open AstFilters; module StringMap = Map.Make String; - module MetaLoc = Camlp4.Struct.MetaAst.MetaGhostLoc Ast; - module MetaAst = Camlp4.Struct.MetaAst.Make MetaLoc; open Ast; value _loc = Loc.ghost; diff --git a/camlp4/Camlp4Filters/LiftCamlp4Ast.ml b/camlp4/Camlp4Filters/LiftCamlp4Ast.ml index 382020d70..6299f2ef7 100644 --- a/camlp4/Camlp4Filters/LiftCamlp4Ast.ml +++ b/camlp4/Camlp4Filters/LiftCamlp4Ast.ml @@ -30,14 +30,14 @@ module Make (AstFilters : Camlp4.Sig.AstFilters.S) = struct module MetaLoc = struct module Ast = Ast; - value meta_loc_patt _loc = <:patt< loc >>; - value meta_loc_expr _loc = <:expr< loc >>; + value meta_loc_patt _loc _ = <:patt< loc >>; + value meta_loc_expr _loc _ = <:expr< loc >>; end; - module MetaAst = Camlp4.Struct.MetaAst.Make MetaLoc; + module MetaAst = Ast.Meta.Make MetaLoc; register_str_item_filter (fun ast -> let _loc = Ast.loc_of_str_item ast in - <:str_item< let loc = Loc.ghost in $exp:MetaAst.Expr.str_item ast$ >>); + <:str_item< let loc = Loc.ghost in $exp:MetaAst.Expr.meta_str_item _loc ast$ >>); end; diff --git a/camlp4/Camlp4Parsers/Grammar.ml b/camlp4/Camlp4Parsers/Grammar.ml index a151e8028..f523eaf2d 100644 --- a/camlp4/Camlp4Parsers/Grammar.ml +++ b/camlp4/Camlp4Parsers/Grammar.ml @@ -28,8 +28,8 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct open Sig.Camlp4Token; include Syntax; - module MetaLoc = Camlp4.Struct.MetaAst.MetaGhostLoc Ast; - module MetaAst = Camlp4.Struct.MetaAst.Make MetaLoc; + module MetaLoc = Ast.Meta.MetaGhostLoc; + module MetaAst = Ast.Meta.Make MetaLoc; module PP = Camlp4.Printers.OCaml.Make Syntax; value pp = new PP.printer ~comments:False (); @@ -300,7 +300,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) = struct in let txt = if meta_action.val then - <:expr< Obj.magic $MetaAst.Expr.expr txt$ >> + <:expr< Obj.magic $MetaAst.Expr.meta_expr _loc txt$ >> else txt in <:expr< $uid:gm$.Action.mk $txt$ >> diff --git a/camlp4/Camlp4Parsers/OCamlQuotationBase.ml b/camlp4/Camlp4Parsers/OCamlQuotationBase.ml index 38c95bc71..8e4fe8f00 100644 --- a/camlp4/Camlp4Parsers/OCamlQuotationBase.ml +++ b/camlp4/Camlp4Parsers/OCamlQuotationBase.ml @@ -29,18 +29,18 @@ module Make (Syntax : Sig.Camlp4Syntax.S) open Sig.Camlp4Token; include Syntax; (* Be careful an AntiquotSyntax module appears here *) - module MetaLocHere = Camlp4.Struct.MetaAst.MetaLoc Ast; + module MetaLocHere = Ast.Meta.MetaLoc; module MetaLoc = struct module Ast = Ast; value loc_name = ref None; - value meta_loc_expr _loc = + value meta_loc_expr _loc loc = match loc_name.val with [ None -> <:expr< $lid:Loc.name.val$ >> - | Some "here" -> MetaLocHere.meta_loc_expr _loc + | Some "here" -> MetaLocHere.meta_loc_expr _loc loc | Some x -> <:expr< $lid:x$ >> ]; - value meta_loc_patt _loc = <:patt< _ >>; + value meta_loc_patt _loc _ = <:patt< _ >>; end; - module MetaAst = Camlp4.Struct.MetaAst.Make MetaLoc; + module MetaAst = Ast.Meta.Make MetaLoc; module ME = MetaAst.Expr; module MP = MetaAst.Patt; @@ -60,7 +60,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) inherit Ast.map as super; method patt = fun [ <:patt@_loc< $anti:s$ >> | <:patt@_loc< $str:s$ >> as p -> - let mloc = MetaLoc.meta_loc_patt in + 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" -> <:patt< Ast.SgAnt $mloc _loc$ $p$ >> @@ -83,7 +83,7 @@ module Make (Syntax : Sig.Camlp4Syntax.S) | p -> super#patt p ]; method expr = fun [ <:expr@_loc< $anti:s$ >> | <:expr@_loc< $str:s$ >> as e -> - let mloc = MetaLoc.meta_loc_expr in + 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" -> <:expr< string_of_int $e$ >> @@ -134,12 +134,12 @@ module Make (Syntax : Sig.Camlp4Syntax.S) let expand_expr loc loc_name_opt s = let ast = Gram.parse_string entry_eoi loc s in let () = MetaLoc.loc_name.val := loc_name_opt in - let meta_ast = mexpr ast 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 ast 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 @@ -159,24 +159,24 @@ module Make (Syntax : Sig.Camlp4Syntax.S) Quotation.add name (Quotation.ExAst (expand_expr, expand_patt)) }; - add_quotation "sig_item" sig_item_quot ME.sig_item MP.sig_item; - add_quotation "str_item" str_item_quot ME.str_item MP.str_item; - add_quotation "ctyp" ctyp_quot ME.ctyp MP.ctyp; - add_quotation "patt" patt_quot ME.patt MP.patt; - add_quotation "expr" expr_quot ME.expr MP.expr; - add_quotation "module_type" module_type_quot ME.module_type MP.module_type; - add_quotation "module_expr" module_expr_quot ME.module_expr MP.module_expr; - add_quotation "class_type" class_type_quot ME.class_type MP.class_type; - add_quotation "class_expr" class_expr_quot ME.class_expr MP.class_expr; + add_quotation "sig_item" sig_item_quot ME.meta_sig_item MP.meta_sig_item; + add_quotation "str_item" str_item_quot ME.meta_str_item MP.meta_str_item; + add_quotation "ctyp" ctyp_quot ME.meta_ctyp MP.meta_ctyp; + add_quotation "patt" patt_quot ME.meta_patt MP.meta_patt; + add_quotation "expr" expr_quot ME.meta_expr MP.meta_expr; + add_quotation "module_type" module_type_quot ME.meta_module_type MP.meta_module_type; + add_quotation "module_expr" module_expr_quot ME.meta_module_expr MP.meta_module_expr; + add_quotation "class_type" class_type_quot ME.meta_class_type MP.meta_class_type; + add_quotation "class_expr" class_expr_quot ME.meta_class_expr MP.meta_class_expr; add_quotation "class_sig_item" - class_sig_item_quot ME.class_sig_item MP.class_sig_item; + class_sig_item_quot ME.meta_class_sig_item MP.meta_class_sig_item; add_quotation "class_str_item" - class_str_item_quot ME.class_str_item MP.class_str_item; - add_quotation "with_constr" with_constr_quot ME.with_constr MP.with_constr; - add_quotation "binding" binding_quot ME.binding MP.binding; - add_quotation "match_case" match_case_quot ME.match_case MP.match_case; + class_str_item_quot ME.meta_class_str_item MP.meta_class_str_item; + add_quotation "with_constr" with_constr_quot ME.meta_with_constr MP.meta_with_constr; + add_quotation "binding" binding_quot ME.meta_binding MP.meta_binding; + add_quotation "match_case" match_case_quot ME.meta_match_case MP.meta_match_case; add_quotation "module_binding" - module_binding_quot ME.module_binding MP.module_binding; - add_quotation "ident" ident_quot ME.ident MP.ident; + module_binding_quot ME.meta_module_binding MP.meta_module_binding; + add_quotation "ident" ident_quot ME.meta_ident MP.meta_ident; end; diff --git a/camlp4/Makefile.ml b/camlp4/Makefile.ml index d13fd5ee9..3383f5948 100644 --- a/camlp4/Makefile.ml +++ b/camlp4/Makefile.ml @@ -110,12 +110,6 @@ and unix = | _ -> "../otherlibs/unix" and build = "build" -let ocaml_Module_with_meta = - generic_ocaml_Module_extension ".meta.ml" - (fun _ i o -> - "if test ! -e"^^o^^ - "|| ( ruby --version > /dev/null 2> /dev/null ) ;"^^ - "then ruby ./build/meta.rb"^^i^^">"^^o^^"; else : ; fi") let ocaml_Module_with_genmap = generic_ocaml_Module_extension ".genmap.ml" (fun _ i o -> @@ -123,6 +117,7 @@ let ocaml_Module_with_genmap = "|| ( test -e ./camlp4boot.run"^^ "&& test -e Camlp4Filters/GenerateMap.cmo"^^ "&& test -e Camlp4Filters/GenerateFold.cmo"^^ + "&& test -e Camlp4Filters/MetaGenerator.cmo"^^ "&& test -e Camlp4Filters/RemoveTrashModule.cmo ) ;"^^ "then ( echo 'module Camlp4FiltersTrash = struct' ;"^^ "cat Camlp4/Sig/Camlp4Ast.ml ; echo 'end;' ) > Camlp4/Struct/Camlp4Ast.tmp.ml ;"^^ @@ -130,6 +125,7 @@ let ocaml_Module_with_genmap = "../boot/ocamlrun ./camlp4boot.run"^^ "./Camlp4Filters/GenerateMap.cmo"^^ "./Camlp4Filters/GenerateFold.cmo"^^ + "./Camlp4Filters/MetaGenerator.cmo"^^ "./Camlp4Filters/RemoveTrashModule.cmo -printer OCamlr"^^ i^^" -no_comments ) >"^^o^^"; else : ; fi") @@ -211,7 +207,6 @@ let camlp4_package_as_one_dir = ocaml_IModule ~ext_includes:[dynlink] "DynLoader"; ocaml_Module_with_genmap ~flags:"-w z -warn-error z" "Camlp4Ast"; ocaml_IModule "FreeVars"; - ocaml_Module_with_meta "MetaAst"; ocaml_Module "AstFilters"; ocaml_IModule ~ext_includes:[parsing] "Camlp4Ast2OCamlAst"; ocaml_Module "CleanAst"; @@ -271,6 +266,7 @@ let camlp4_filters = ocaml_Module "LiftCamlp4Ast"; ocaml_Module "GenerateMap"; ocaml_Module "GenerateFold"; + ocaml_Module "MetaGenerator"; ocaml_Module "RemoveTrashModule"; ocaml_Module "Profiler"; ]) @@ -301,6 +297,7 @@ let pr_o = ocaml_Module "Camlp4Printers/OCaml" let pr_a = ocaml_Module "Camlp4Printers/Auto" let fi_exc = ocaml_Module "Camlp4Filters/ExceptionTracer" let fi_tracer = ocaml_Module "Camlp4Filters/Tracer" +let fi_meta = ocaml_Module "Camlp4Filters/MetaGenerator" let camlp4_bin = ocaml_Module "Camlp4Bin" let top_rprint = ocaml_Module "Camlp4Top/Rprint" let top_camlp4_top = ocaml_Module "Camlp4Top/Camlp4Top" |