Update internal state of the typer

type:internal

The typer (src/pass/10-checking) keeps information around about the context of E_application in an ad-hoc way through variables last and args. This MR improves the representation by keeping an application context structure where things are pushed/popped.

src/passes/10-checking/checking.ml

@@ -8,12 +8,13 @@ open O.Combinators
 
 module Pair = Simple_utils.Pair
 module App_context = Context.App_context
-type context = Context.t
+type typing_context = Context.t
 type app_context = App_context.t
+type context = app_context * typing_context
 
 let assert_type_expression_eq = Helpers.assert_type_expression_eq
 
-let rec type_module_expr ~raise ~init_context ~options : I.module_expr -> context * O.module_expr = fun m_expr ->
+let rec type_module_expr ~raise ~init_context ~options : I.module_expr -> typing_context * O.module_expr = fun m_expr ->
   let return x =
     let ret = Location.wrap ~loc:m_expr.location x in
     let ctxt = Context.context_of_module_expr ~outer_context:init_context ret in
@@ -27,7 +28,7 @@ let rec type_module_expr ~raise ~init_context ~options : I.module_expr -> contex
     let prg = type_module ~init_context ~raise ~options prg in
     return (O.M_struct prg)
   | I.M_module_path path ->
-    let _ctxt : context = List.fold
+    let _ctxt : typing_context = List.fold
       ~f:(fun acc v -> trace_option ~raise (unbound_module_variable v (I.ModuleVar.get_location v)) (Context.get_module acc v))
       ~init:init_context
       (List.Ne.to_list path)
@@ -38,7 +39,7 @@ let rec type_module_expr ~raise ~init_context ~options : I.module_expr -> contex
     return (O.M_variable v)
 
 and type_module ~raise ~options ~init_context (p:I.module_) : O.module_ =
-  let aux (c, acc:(context * O.declaration list)) (d:I.declaration) =
+  let aux (c, acc:(typing_context * O.declaration list)) (d:I.declaration) =
     let (c, d') = type_declaration' ~raise ~options c d in
     (c, d' :: acc)
   in
@@ -47,7 +48,7 @@ and type_module ~raise ~options ~init_context (p:I.module_) : O.module_ =
       List.fold ~f:aux ~init:(init_context, []) p in
   List.rev lst
 
-and type_declaration' : raise: typer_error raise -> options: Compiler_options.middle_end -> context -> I.declaration -> context * O.declaration =
+and type_declaration' : raise: typer_error raise -> options: Compiler_options.middle_end -> typing_context -> I.declaration -> typing_context * O.declaration =
 fun ~raise ~options c d ->
 let loc = d.location in
 let return ?(loc = loc) c (d : O.declaration_content) = c,Location.wrap ~loc d in
@@ -97,7 +98,7 @@ match Location.unwrap d with
     return post_env @@ Declaration_module { module_binder; module_; module_attr = {public}}
   )
 
-and evaluate_otype ~raise (c:context) (t:O.type_expression) : O.type_expression =
+and evaluate_otype ~raise (c:typing_context) (t:O.type_expression) : O.type_expression =
   (* NOTE: this is similar to evaluate_type, but just look up for variables in environemnt
     feels wrong, but that's to allow re-evaluate body of T_abstractions *)
   let return tv' = make_t ~loc:t.location tv' t.type_meta in
@@ -169,7 +170,7 @@ and evaluate_otype ~raise (c:context) (t:O.type_expression) : O.type_expression
     let type_ = evaluate_otype ~raise c x.type_ in
     return (T_for_all {x with type_})
 
-and evaluate_type ~raise (c:context) (t:I.type_expression) : O.type_expression =
+and evaluate_type ~raise (c:typing_context) (t:I.type_expression) : O.type_expression =
   let return tv' = make_t ~loc:t.location tv' (Some t) in
   match t.type_content with
   | T_arrow {type1;type2} ->
@@ -258,7 +259,7 @@ and evaluate_type ~raise (c:context) (t:I.type_expression) : O.type_expression =
         raise.raise (type_constant_wrong_number_of_arguments (Some type_operator) expected actual t.location)
       | Ok x -> x
     in
-    let aux : context -> (I.type_variable * I.type_expression) -> context =
+    let aux : typing_context -> (I.type_variable * I.type_expression) -> typing_context =
       fun c (ty_binder,arg) ->
         let arg' = evaluate_type ~raise c arg in
         let () = is_fully_applied arg.location arg' in
@@ -311,7 +312,7 @@ and infer_t_insts ~raise ~loc app_context ( (tc,t) : O.expression_content * O.ty
     x.expression_content , x.type_expression
   | _ -> tc, t
 
-and type_expression' ~raise ~options : app_context * context -> ?tv_opt:O.type_expression -> I.expression -> O.expression = fun (app_context, context) ?tv_opt e ->
+and type_expression' ~raise ~options : context -> ?tv_opt:O.type_expression -> I.expression -> O.expression = fun (app_context, context) ?tv_opt e ->
   let return expr tv =
     let () =
       match tv_opt with
@@ -608,7 +609,7 @@ and type_expression' ~raise ~options : app_context * context -> ?tv_opt:O.type_e
   (* Advanced *)
   | E_matching {matchee;cases} -> (
     let matchee' = type_expression' ~raise ~options (app_context, context) matchee in
-    let aux : (I.expression, I.type_expression) I.match_case -> ((I.type_expression I.pattern * O.type_expression) list * (I.expression * context)) =
+    let aux : (I.expression, I.type_expression) I.match_case -> ((I.type_expression I.pattern * O.type_expression) list * (I.expression * typing_context)) =
       fun {pattern ; body} -> ([(pattern,matchee'.type_expression)], (body,context))
     in
     let eqs = List.map ~f:aux cases in