diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 56ad30c28..2c816338d 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -22,7 +22,7 @@ let compile_expression_as_value ?(env = Ast_typed.Environment.full_empty) ~(stat let%bind (typed , state) = Typer.type_expression env state ae in (* TODO: move this to typer.ml *) let typed = - if false then + if Typer.use_new_typer then let () = failwith "TODO : subst all" in let _todo = ignore (env, state) in typed else typed diff --git a/src/passes/4-typer-new/solver.ml b/src/passes/4-typer-new/solver.ml index e132784ee..6f9100d2a 100644 --- a/src/passes/4-typer-new/solver.ml +++ b/src/passes/4-typer-new/solver.ml @@ -1113,3 +1113,5 @@ let aggregate_constraints : state -> type_constraint list -> state result = fun constraints, and that all existential variables are instantiated (possibly by first generalizing the type and then using the polymorphic type argument to instantiate the existential). *) + +let placeholder_for_state_of_new_typer () = initial_state diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index 6a82ba9a6..6f7b82eea 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/4-typer-new/typer.ml @@ -391,7 +391,8 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_value result = let%bind lst' = bind_list @@ List.map (evaluate_type e) lst in return (T_constant(Type_name cst, lst')) -and type_expression : environment -> Solver.state -> I.expression -> (O.annotated_expression * Solver.state) result = fun e state ae -> +and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.expression -> (O.annotated_expression * Solver.state) result = fun e state ?tv_opt ae -> + let () = ignore tv_opt in (* For compatibility with the old typer's API, this argument can be removed once the new typer is used. *) let open Solver in let module L = Logger.Stateful() in let return : _ -> Solver.state -> _ -> _ (* return of type_expression *) = fun expr state constraints type_name -> diff --git a/src/passes/4-typer-new/typer.mli b/src/passes/4-typer-new/typer.mli index e60ce51bb..386313702 100644 --- a/src/passes/4-typer-new/typer.mli +++ b/src/passes/4-typer-new/typer.mli @@ -44,7 +44,7 @@ val type_program' : I.program -> (O.program) result (* TODO: merge with type_pro val type_declaration : environment -> Solver.state -> I.declaration -> (environment * Solver.state * O.declaration option) result (* val type_match : (environment -> 'i -> 'o result) -> environment -> O.type_value -> 'i I.matching -> I.expression -> Location.t -> 'o O.matching result *) val evaluate_type : environment -> I.type_expression -> O.type_value result -val type_expression : environment -> Solver.state -> I.expression -> (O.annotated_expression * Solver.state) result +val type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.expression -> (O.annotated_expression * Solver.state) result val type_constant : string -> O.type_value list -> O.type_value option -> Location.t -> (string * O.type_value) result (* val untype_type_value : O.type_value -> (I.type_expression) result diff --git a/src/passes/4-typer-new/typer_new.ml b/src/passes/4-typer-new/typer_new.ml new file mode 100644 index 000000000..ba132b977 --- /dev/null +++ b/src/passes/4-typer-new/typer_new.ml @@ -0,0 +1 @@ +include Typer diff --git a/src/passes/4-typer-old/dune b/src/passes/4-typer-old/dune index 0ee58cc43..29e48c79e 100644 --- a/src/passes/4-typer-old/dune +++ b/src/passes/4-typer-old/dune @@ -1,11 +1,12 @@ (library - (name typer) - (public_name ligo.typer) + (name typer_old) + (public_name ligo.typer_old) (libraries simple-utils tezos-utils ast_simplified ast_typed + typer_new operators ) (preprocess diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index 2751225eb..c21943e5e 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/4-typer-old/typer.ml @@ -8,11 +8,11 @@ module SMap = O.SMap module Environment = O.Environment -module Solver = struct +module Solver = Typer_new.Solver (* struct type state = Placeholder_for_state_of_new_typer let discard_state (_ : state) = () let initial_state = Placeholder_for_state_of_new_typer -end +end *) type environment = Environment.t @@ -226,7 +226,7 @@ open Errors let rec type_program (p:I.program) : (O.program * Solver.state) result = let aux (e, acc:(environment * O.declaration Location.wrap list)) (d:I.declaration Location.wrap) = - let%bind ed' = (bind_map_location (type_declaration e Solver.Placeholder_for_state_of_new_typer)) d in + let%bind ed' = (bind_map_location (type_declaration e (Solver.placeholder_for_state_of_new_typer ()))) d in let loc : 'a . 'a Location.wrap -> _ -> _ = fun x v -> Location.wrap ~loc:x.location v in let (e', _placeholder_for_state_of_new_typer , d') = Location.unwrap ed' in match d' with @@ -236,20 +236,20 @@ let rec type_program (p:I.program) : (O.program * Solver.state) result = let%bind (_, lst) = trace (fun () -> program_error p ()) @@ bind_fold_list aux (Environment.full_empty, []) p in - ok @@ (List.rev lst , Solver.Placeholder_for_state_of_new_typer) + ok @@ (List.rev lst , (Solver.placeholder_for_state_of_new_typer ())) and type_declaration env (_placeholder_for_state_of_new_typer : Solver.state) : I.declaration -> (environment * Solver.state * O.declaration option) result = function | Declaration_type (type_name , type_expression) -> let%bind tv = evaluate_type env type_expression in let env' = Environment.add_type type_name tv env in - ok (env', Solver.Placeholder_for_state_of_new_typer , None) + ok (env', (Solver.placeholder_for_state_of_new_typer ()) , None) | Declaration_constant (name , tv_opt , expression) -> ( let%bind tv'_opt = bind_map_option (evaluate_type env) tv_opt in let%bind ae' = trace (constant_declaration_error name expression tv'_opt) @@ type_expression' ?tv_opt:tv'_opt env expression in let env' = Environment.add_ez_ae name ae' env in - ok (env', Solver.Placeholder_for_state_of_new_typer , Some (O.Declaration_constant ((make_n_e name ae') , (env , env')))) + ok (env', (Solver.placeholder_for_state_of_new_typer ()) , Some (O.Declaration_constant ((make_n_e name ae') , (env , env')))) ) and type_match : type i o . (environment -> i -> o result) -> environment -> O.type_value -> i I.matching -> I.expression -> Location.t -> o O.matching result = @@ -384,7 +384,7 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_value result = and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.expression -> (O.annotated_expression * Solver.state) result = fun e _placeholder_for_state_of_new_typer ?tv_opt ae -> let%bind res = type_expression' e ?tv_opt ae in - ok (res, Solver.Placeholder_for_state_of_new_typer) + ok (res, (Solver.placeholder_for_state_of_new_typer ())) and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.annotated_expression result = fun e ?tv_opt ae -> let module L = Logger.Stateful() in let return expr tv = diff --git a/src/passes/4-typer-old/typer.mli b/src/passes/4-typer-old/typer.mli index ddc2ebb59..315d38c84 100644 --- a/src/passes/4-typer-old/typer.mli +++ b/src/passes/4-typer-old/typer.mli @@ -6,11 +6,11 @@ module O = Ast_typed module SMap = O.SMap module Environment = O.Environment -module Solver : sig +module Solver : module type of Typer_new.Solver (* sig type state = Placeholder_for_state_of_new_typer val discard_state : state -> unit val initial_state : state -end +end *) type environment = Environment.t diff --git a/src/passes/4-typer-old/typer_old.ml b/src/passes/4-typer-old/typer_old.ml new file mode 100644 index 000000000..ba132b977 --- /dev/null +++ b/src/passes/4-typer-old/typer_old.ml @@ -0,0 +1 @@ +include Typer diff --git a/src/passes/4-typer/dune b/src/passes/4-typer/dune new file mode 100644 index 000000000..dc6164c4f --- /dev/null +++ b/src/passes/4-typer/dune @@ -0,0 +1,17 @@ +(library + (name typer) + (public_name ligo.typer) + (libraries + simple-utils + tezos-utils + ast_simplified + ast_typed + typer_old + typer_new + operators + ) + (preprocess + (pps ppx_let) + ) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils )) +) diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml new file mode 100644 index 000000000..cd06f1a79 --- /dev/null +++ b/src/passes/4-typer/typer.ml @@ -0,0 +1,15 @@ +let use_new_typer = false + +module I = Ast_simplified +module O = Ast_typed + +module SMap = O.SMap +module Environment = O.Environment + +module Solver = Typer_new.Solver (* Both the old typer and the new typer use the same solver state. *) + +type environment = Environment.t + +let type_program = if use_new_typer then Typer_new.type_program else Typer_old.type_program +let type_expression = if use_new_typer then Typer_new.type_expression else Typer_old.type_expression +let untype_expression = if use_new_typer then Typer_new.untype_expression else Typer_old.untype_expression diff --git a/src/passes/4-typer/typer.mli b/src/passes/4-typer/typer.mli new file mode 100644 index 000000000..4468ed042 --- /dev/null +++ b/src/passes/4-typer/typer.mli @@ -0,0 +1,18 @@ +val use_new_typer : bool + +open Trace + +module I = Ast_simplified +module O = Ast_typed + +module SMap = O.SMap +module Environment = O.Environment + +module Solver = Typer_new.Solver + +type environment = Environment.t + +val type_program : I.program -> (O.program * Solver.state) result +val type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.expression -> (O.annotated_expression * Solver.state) result +val untype_expression : O.annotated_expression -> I.expression result +