Rename 4-typer to 4-typer-old (part 2: make changes)

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

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

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 ->

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

src/passes/4-typer-new/typer_new.ml

@@ -0,0 +1 @@
+include Typer

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

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 =

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
 

src/passes/4-typer-old/typer_old.ml

@@ -0,0 +1 @@
+include Typer

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 ))
+)

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

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
+