fix module type normalize: add constructor to environment

butterunderflow · Aug 6, 2024 · 76a9fb9 · 76a9fb9
1 parent 52758ea
commit 76a9fb9
Show file tree

Hide file tree

Showing 3 changed files with 57 additions and 7 deletions.
diff --git a/lib/typing/check.ml b/lib/typing/check.ml
@@ -601,7 +601,9 @@ and normalize_msig comps env =
             Env.add_value name (P.generalize (normalize_ty te env) env) env
         | T.TAbstTySpec (name, paras) ->
             Env.add_type_def (TDOpaqueI (name, paras)) env
-        | T.TManiTySpec def -> Env.add_type_def (normalize_def def env) env
+        | T.TManiTySpec def ->
+            let _, env = check_top_level (T.TopTypeDef def) env in
+            env
         | T.TModSpec (name, ext_mt) ->
             let mt = normalize_mt ext_mt env in
             Env.add_module name mt env

diff --git a/tests/regular/render_typed_test.ml b/tests/regular/render_typed_test.ml
@@ -1339,6 +1339,9 @@ module MMM = (M(F).K : I)
 
                            id = 3
 
+                           constr Nil[0] : (() 1.t
+                                             ->() 3.n)
+
                            type () n =
                            | Nil of () 1.t
 
@@ -1353,6 +1356,9 @@ module MMM = (M(F).K : I)
 
                                    id = 4
 
+                                   constr Nil[0] : (() 1.t
+                                                     ->() 4.n)
+
                                    type () n =
                                    | Nil of () 1.t
 
@@ -1383,6 +1389,9 @@ module MMM = (M(F).K : I)
 
                             id = 6
 
+                            constr Nil[0] : (() int
+                                              ->() 6.n)
+
                             type () n =
                             | Nil of () int
 

diff --git a/tests/regular/typing_test.ml b/tests/regular/typing_test.ml
@@ -586,9 +586,11 @@ let%expect_test "Test: full program typing" =
   [%expect
     {|
     ((TopModSig MIntf
-       (MTMod (id 1) (val_defs ((x (() (TConsI (1 t) ()))))) (constr_defs ())
+       (MTMod (id 1) (val_defs ((x (() (TConsI (1 t) ())))))
+         (constr_defs ((Nil ((() (TConsI (1 t) ())) 0))))
          (ty_defs ((TDAdtI t () ((Nil ()))))) (mod_sigs ()) (mod_defs ())
-         (owned_mods ()))))|}];
+         (owned_mods ()))))
+    |}];
 
   print_effect
     {|
@@ -611,7 +613,8 @@ let%expect_test "Test: full program typing" =
     Module Definitions:
 
     Module Types:
-      MIntf |-> (MTMod (id 1) (val_defs ((x (() (TConsI (1 t) ()))))) (constr_defs ())
+      MIntf |-> (MTMod (id 1) (val_defs ((x (() (TConsI (1 t) ())))))
+      (constr_defs ((Nil ((() (TConsI (1 t) ())) 0))))
       (ty_defs ((TDAdtI t () ((Nil ()))))) (mod_sigs ()) (mod_defs ())
       (owned_mods ()))
     Module Creation History:
@@ -620,7 +623,8 @@ let%expect_test "Test: full program typing" =
       0
     ++++++++++++++++++Scope Debug Info Begin++++++++++++++++++
 
-    ------------------Envirment Debug Info End-------------------------- |}];
+    ------------------Envirment Debug Info End--------------------------
+    |}];
 
   print_typed
     {|
@@ -1167,7 +1171,8 @@ external print_int : int ->  int = "ff_builtin_print_int"
        type () t
      end)
      |};
-  [%expect {|
+  [%expect
+    {|
     ((TopMod F
        (MERestrict
          (MERestrict
@@ -1579,4 +1584,38 @@ module L2 = (K: M)
 
      module F = M.N
      |};
-  [%expect {| try get field from functor |}]
+  [%expect {| try get field from functor |}];
+  print_typed
+    {|
+               module type MT = sig
+                 type t = | Nil
+               end
+
+               module M = (struct
+                 type t = | Nil
+               end : MT)
+
+               |};
+  [%expect
+    {|
+    ((TopModSig MT
+       (MTMod (id 1) (val_defs ())
+         (constr_defs ((Nil ((() (TConsI (1 t) ())) 0))))
+         (ty_defs ((TDAdtI t () ((Nil ()))))) (mod_sigs ()) (mod_defs ())
+         (owned_mods ())))
+      (TopMod M
+        (MERestrict
+          (MEStruct ((TopTypeDef (TDAdtI t () ((Nil ())))))
+            (MTMod (id 2) (val_defs ())
+              (constr_defs ((Nil ((() (TConsI (2 t) ())) 0))))
+              (ty_defs ((TDAdtI t () ((Nil ()))))) (mod_sigs ()) (mod_defs ())
+              (owned_mods ())))
+          (MTMod (id 1) (val_defs ())
+            (constr_defs ((Nil ((() (TConsI (1 t) ())) 0))))
+            (ty_defs ((TDAdtI t () ((Nil ()))))) (mod_sigs ()) (mod_defs ())
+            (owned_mods ()))
+          (MTMod (id 3) (val_defs ())
+            (constr_defs ((Nil ((() (TConsI (3 t) ())) 0))))
+            (ty_defs ((TDAdtI t () ((Nil ()))))) (mod_sigs ()) (mod_defs ())
+            (owned_mods ())))))
+    |}]