From ee2f3b428c074539f14dacae1faeb07a9de4be77 Mon Sep 17 00:00:00 2001 From: Leandro Ostera Date: Thu, 5 Nov 2020 19:06:12 +0100 Subject: [PATCH] Move typed_impl to Typedtree.t --- .depend | 2 -- driver/compile.ml | 2 +- driver/compile.mli | 2 +- driver/compile_common.mli | 4 ++-- driver/optcompile.ml | 4 ++-- driver/optcompile.mli | 4 ++-- ocamldoc/odoc_analyse.ml | 2 +- typing/printtyped.ml | 2 +- typing/printtyped.mli | 2 +- typing/typedtree.ml | 7 +++++++ typing/typedtree.mli | 6 ++++++ typing/typemod.ml | 6 ------ typing/typemod.mli | 8 +------- typing/untypeast.ml | 8 ++++---- 14 files changed, 29 insertions(+), 30 deletions(-) diff --git a/.depend b/.depend index d6e7fe706..487599130 100644 --- a/.depend +++ b/.depend @@ -1010,7 +1010,6 @@ typing/printtyp.cmi : \ parsing/asttypes.cmi typing/printtyped.cmo : \ typing/types.cmi \ - typing/typemod.cmi \ typing/typedtree.cmi \ parsing/printast.cmi \ typing/path.cmi \ @@ -1023,7 +1022,6 @@ typing/printtyped.cmo : \ typing/printtyped.cmi typing/printtyped.cmx : \ typing/types.cmx \ - typing/typemod.cmx \ typing/typedtree.cmx \ parsing/printast.cmx \ typing/path.cmx \ diff --git a/driver/compile.ml b/driver/compile.ml index 954956327..7a88388c3 100644 --- a/driver/compile.ml +++ b/driver/compile.ml @@ -27,7 +27,7 @@ let interface ~source_file ~output_prefix = (** Bytecode compilation backend for .ml files. *) -let to_bytecode i Typemod.{structure; coercion; _} = +let to_bytecode i Typedtree.{structure; coercion; _} = (structure, coercion) |> Profile.(record transl) (Translmod.transl_implementation i.module_name) diff --git a/driver/compile.mli b/driver/compile.mli index 0256bd43a..32872b1ea 100644 --- a/driver/compile.mli +++ b/driver/compile.mli @@ -25,7 +25,7 @@ val implementation: val to_bytecode : Compile_common.info -> - Typemod.typed_impl -> + Typedtree.t -> Instruct.instruction list * Ident.Set.t (** [to_bytecode info typed] takes a typechecked implementation and returns its bytecode. diff --git a/driver/compile_common.mli b/driver/compile_common.mli index 170cddea8..6a062aba4 100644 --- a/driver/compile_common.mli +++ b/driver/compile_common.mli @@ -68,13 +68,13 @@ val interface : info -> unit val parse_impl : info -> Parsetree.structure (** [parse_impl info] parses an implementation (usually an [.ml] file). *) -val typecheck_impl : info -> Parsetree.structure -> Typemod.typed_impl +val typecheck_impl : info -> Parsetree.structure -> Typedtree.t (** [typecheck_impl info parsetree] typechecks an implementation and returns the typedtree of the associated module, its public interface, and a coercion against that public interface. *) -val implementation : info -> backend:(info -> Typemod.typed_impl -> unit) -> unit +val implementation : info -> backend:(info -> Typedtree.t -> unit) -> unit (** The complete compilation pipeline for implementations. *) (** {2 Build artifacts} *) diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 99f2c0751..51fc23cfb 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -31,7 +31,7 @@ let (|>>) (x, y) f = (x, f y) (** Native compilation backend for .ml files. *) -let flambda i backend Typemod.{structure; coercion; _} = +let flambda i backend Typedtree.{structure; coercion; _} = if !Clflags.classic_inlining then begin Clflags.default_simplify_rounds := 1; Clflags.use_inlining_arguments_set Clflags.classic_arguments; @@ -66,7 +66,7 @@ let flambda i backend Typemod.{structure; coercion; _} = program); Compilenv.save_unit_info (cmx i)) -let clambda i backend Typemod.{structure; coercion; _} = +let clambda i backend Typedtree.{structure; coercion; _} = Clflags.use_inlining_arguments_set Clflags.classic_arguments; (structure, coercion) |> Profile.(record transl) diff --git a/driver/optcompile.mli b/driver/optcompile.mli index bc91ac60e..516377798 100644 --- a/driver/optcompile.mli +++ b/driver/optcompile.mli @@ -25,13 +25,13 @@ val implementation: (** {2 Internal functions} **) val clambda : - Compile_common.info -> (module Backend_intf.S) -> Typemod.typed_impl-> unit + Compile_common.info -> (module Backend_intf.S) -> Typedtree.t-> unit (** [clambda info typed] applies the regular compilation pipeline to the given typechecked implementation and outputs the resulting files. *) val flambda : - Compile_common.info -> (module Backend_intf.S) -> Typemod.typed_impl -> unit + Compile_common.info -> (module Backend_intf.S) -> Typedtree.t -> unit (** [flambda info backend typed] applies the Flambda compilation pipeline to the given typechecked implementation and outputs the resulting files. *) diff --git a/ocamldoc/odoc_analyse.ml b/ocamldoc/odoc_analyse.ml index fb30f61dd..f9ec3cb69 100644 --- a/ocamldoc/odoc_analyse.ml +++ b/ocamldoc/odoc_analyse.ml @@ -151,7 +151,7 @@ let process_file sourcefile = match parsetree_typedtree_opt with None -> None - | Some (parsetree, Typemod.{structure; coercion; _}) -> + | Some (parsetree, Typedtree.{structure; coercion; _}) -> let typedtree = (structure, coercion) in let file_module = Ast_analyser.analyse_typed_tree file input_file parsetree typedtree diff --git a/typing/printtyped.ml b/typing/printtyped.ml index 90b8395fe..eb9a06cf5 100644 --- a/typing/printtyped.ml +++ b/typing/printtyped.ml @@ -942,4 +942,4 @@ let interface ppf x = list 0 signature_item ppf x.sig_items;; let implementation ppf x = list 0 structure_item ppf x.str_items;; -let implementation_with_coercion ppf Typemod.{structure; _} = implementation ppf structure +let implementation_with_coercion ppf Typedtree.{structure; _} = implementation ppf structure diff --git a/typing/printtyped.mli b/typing/printtyped.mli index 951354abf..438e2c1de 100644 --- a/typing/printtyped.mli +++ b/typing/printtyped.mli @@ -19,4 +19,4 @@ open Format;; val interface : formatter -> signature -> unit;; val implementation : formatter -> structure -> unit;; -val implementation_with_coercion : formatter -> Typemod.typed_impl -> unit;; +val implementation_with_coercion : formatter -> Typedtree.t -> unit;; diff --git a/typing/typedtree.ml b/typing/typedtree.ml index ca81b0f05..232ecf9d9 100644 --- a/typing/typedtree.ml +++ b/typing/typedtree.ml @@ -613,6 +613,13 @@ and 'a class_infos = ci_attributes: attribute list; } +type t = { + structure: structure; + coercion: module_coercion; + signature: Types.signature +} + + (* Auxiliary functions over the a.s.t. *) let as_computation_pattern (p : pattern) : computation general_pattern = diff --git a/typing/typedtree.mli b/typing/typedtree.mli index 1323505cd..6e2f400e8 100644 --- a/typing/typedtree.mli +++ b/typing/typedtree.mli @@ -752,6 +752,12 @@ and 'a class_infos = ci_attributes: attributes; } +type t = { + structure: structure; + coercion: module_coercion; + signature: Types.signature +} + (* Auxiliary functions over the a.s.t. *) (** [as_computation_pattern p] is a computation pattern with description diff --git a/typing/typemod.ml b/typing/typemod.ml index 7601a321c..fd65179c2 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -106,12 +106,6 @@ type error = exception Error of Location.t * Env.t * error exception Error_forward of Location.error -type typed_impl = { - structure: Typedtree.structure; - coercion: Typedtree.module_coercion; - signature: Types.signature -} - open Typedtree let rec path_concat head p = diff --git a/typing/typemod.mli b/typing/typemod.mli index 5d3420f79..89579facb 100644 --- a/typing/typemod.mli +++ b/typing/typemod.mli @@ -29,12 +29,6 @@ module Signature_names : sig val simplify: Env.t -> t -> signature -> signature end -type typed_impl = { - structure: Typedtree.structure; - coercion: Typedtree.module_coercion; - signature: Types.signature -} - val type_module: Env.t -> Parsetree.module_expr -> Typedtree.module_expr val type_structure: @@ -44,7 +38,7 @@ val type_toplevel_phrase: Env.t -> Parsetree.structure -> Typedtree.structure * Types.signature * Signature_names.t * Env.t val type_implementation: - string -> string -> string -> Env.t -> Parsetree.structure -> typed_impl + string -> string -> string -> Env.t -> Parsetree.structure -> Typedtree.t val type_interface: Env.t -> Parsetree.signature -> Typedtree.signature val transl_signature: diff --git a/typing/untypeast.ml b/typing/untypeast.ml index dc36aaf43..1ff4ae6d2 100644 --- a/typing/untypeast.ml +++ b/typing/untypeast.ml @@ -605,7 +605,7 @@ let functor_parameter sub : functor_parameter -> Parsetree.functor_parameter = | Unit -> Unit | Named (_, name, mtype) -> Named (name, sub.module_type sub mtype) -let module_type sub mty = +let module_type (sub : mapper) mty = let loc = sub.location sub mty.mty_loc in let attrs = sub.attributes sub mty.mty_attributes in let desc = match mty.mty_desc with @@ -633,7 +633,7 @@ let with_constraint sub (_path, lid, cstr) = | Twith_modsubst (_path, lid2) -> Pwith_modsubst (map_loc sub lid, map_loc sub lid2) -let module_expr sub mexpr = +let module_expr (sub : mapper) mexpr = let loc = sub.location sub mexpr.mod_loc in let attrs = sub.attributes sub mexpr.mod_attributes in match mexpr.mod_desc with @@ -882,10 +882,10 @@ let default_mapper = object_field = object_field ; } -let untype_structure ?(mapper=default_mapper) structure = +let untype_structure ?(mapper : mapper = default_mapper) structure = mapper.structure mapper structure -let untype_signature ?(mapper=default_mapper) signature = +let untype_signature ?(mapper : mapper = default_mapper) signature = mapper.signature mapper signature let untype_expression ?(mapper=default_mapper) expression =