Adding typing for closure env

compiler/scopelang/dependency.ml

@@ -258,7 +258,7 @@ let rec get_structs_or_enums_in_type (t : typ) : TVertexSet.t =
       |> List.map get_structs_or_enums_in_type
       |> List.fold_left TVertexSet.union TVertexSet.empty)
       (get_structs_or_enums_in_type t2)
-  | TLit _ | TAny -> TVertexSet.empty
+  | TClosureEnv | TLit _ | TAny -> TVertexSet.empty
   | TOption t1 | TArray t1 -> get_structs_or_enums_in_type t1
   | TTuple ts ->
     List.fold_left

compiler/shared_ast/definitions.ml

@@ -149,6 +149,7 @@ and naked_typ =
   | TArrow of typ list * typ
   | TArray of typ
   | TAny
+  | TClosureEnv  (** Hides an existential type needed for closure conversion *)
 
 (** {2 Constants and operators} *)
 

compiler/shared_ast/print.ml

@@ -162,6 +162,7 @@ let rec typ
     Format.fprintf fmt "@[<hov 2>%a@ %a@]" base_type "collection" (typ ~colors)
       t1
   | TAny -> base_type fmt "any"
+  | TClosureEnv -> base_type fmt "closure_env"
 
 let lit (fmt : Format.formatter) (l : lit) : unit =
   match l with

compiler/shared_ast/type.ml

@@ -31,9 +31,9 @@ let rec equal ty1 ty2 =
   | TOption t1, TOption t2 -> equal t1 t2
   | TArrow (t1, t1'), TArrow (t2, t2') -> equal_list t1 t2 && equal t1' t2'
   | TArray t1, TArray t2 -> equal t1 t2
-  | TAny, TAny -> true
+  | TClosureEnv, TClosureEnv | TAny, TAny -> true
   | ( ( TLit _ | TTuple _ | TStruct _ | TEnum _ | TOption _ | TArrow _
-      | TArray _ | TAny ),
+      | TArray _ | TAny | TClosureEnv ),
       _ ) ->
     false
 
@@ -52,7 +52,9 @@ let rec unifiable ty1 ty2 =
   | TArrow (t1, t1'), TArrow (t2, t2') ->
     unifiable_list t1 t2 && unifiable t1' t2'
   | TArray t1, TArray t2 -> unifiable t1 t2
-  | ( (TLit _ | TTuple _ | TStruct _ | TEnum _ | TOption _ | TArrow _ | TArray _),
+  | TClosureEnv, TClosureEnv -> true
+  | ( ( TLit _ | TTuple _ | TStruct _ | TEnum _ | TOption _ | TArrow _
+      | TArray _ | TClosureEnv ),
       _ ) ->
     false
 
@@ -69,7 +71,7 @@ let rec compare ty1 ty2 =
   | TArrow (a1, b1), TArrow (a2, b2) -> (
     match List.compare compare a1 a2 with 0 -> compare b1 b2 | n -> n)
   | TArray t1, TArray t2 -> compare t1 t2
-  | TAny, TAny -> 0
+  | TAny, TAny | TClosureEnv, TClosureEnv -> 0
   | TLit _, _ -> -1
   | _, TLit _ -> 1
   | TTuple _, _ -> -1
@@ -84,5 +86,7 @@ let rec compare ty1 ty2 =
   | _, TArrow _ -> 1
   | TArray _, _ -> -1
   | _, TArray _ -> 1
+  | TClosureEnv, _ -> -1
+  | _, TClosureEnv -> 1
 
 let rec arrow_return = function TArrow (_, b), _ -> arrow_return b | t -> t

compiler/shared_ast/typing.ml

@@ -46,6 +46,7 @@ and naked_typ =
   | TOption of unionfind_typ
   | TArray of unionfind_typ
   | TAny of Any.t
+  | TClosureEnv
 
 let rec typ_to_ast ~leave_unresolved (ty : unionfind_typ) : A.typ =
   let typ_to_ast = typ_to_ast ~leave_unresolved in
@@ -66,6 +67,7 @@ let rec typ_to_ast ~leave_unresolved (ty : unionfind_typ) : A.typ =
          typing. *)
       Messages.raise_spanned_error pos
         "Internal error: typing at this point could not be resolved"
+  | TClosureEnv -> TClosureEnv, pos
 
 let rec ast_to_typ (ty : A.typ) : unionfind_typ =
   let ty' =
@@ -78,6 +80,7 @@ let rec ast_to_typ (ty : A.typ) : unionfind_typ =
     | A.TOption t -> TOption (ast_to_typ t)
     | A.TArray t -> TArray (ast_to_typ t)
     | A.TAny -> TAny (Any.fresh ())
+    | A.TClosureEnv -> TClosureEnv
   in
   UnionFind.make (Mark.copy ty ty')
 
@@ -154,6 +157,7 @@ let rec format_typ
   | TAny v ->
     if !Cli.debug_flag then Format.fprintf fmt "<a%d>" (Any.hash v)
     else Format.pp_print_string fmt "<any>"
+  | TClosureEnv -> Format.fprintf fmt "closure_env"
 
 let rec colors =
   let open Ocolor_types in
@@ -192,9 +196,10 @@ let rec unify
       if not (A.EnumName.equal e1 e2) then raise_type_error ()
     | TOption t1, TOption t2 -> unify e t1 t2
     | TArray t1', TArray t2' -> unify e t1' t2'
+    | TClosureEnv, TClosureEnv -> ()
     | TAny _, _ | _, TAny _ -> ()
     | ( ( TLit _ | TArrow _ | TTuple _ | TStruct _ | TEnum _ | TOption _
-        | TArray _ ),
+        | TArray _ | TClosureEnv ),
         _ ) ->
       raise_type_error ()
   in