Immediacy rework (ocaml-flambda#122)

* Make immediacy part of type_kind (backport PR #11841)

* disable stack allocation for 32-bit CI build

.depend

@@ -1157,7 +1157,6 @@ typing/persistent_env.cmi : \
     file_formats/cmi_format.cmi
 typing/predef.cmo : \
     typing/types.cmi \
-    typing/type_immediacy.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
     parsing/location.cmi \
@@ -1168,7 +1167,6 @@ typing/predef.cmo : \
     typing/predef.cmi
 typing/predef.cmx : \
     typing/types.cmx \
-    typing/type_immediacy.cmx \
     typing/path.cmx \
     parsing/parsetree.cmi \
     parsing/location.cmx \
@@ -1513,7 +1511,6 @@ typing/typecore.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
     typing/typedecl.cmi \
-    typing/type_immediacy.cmi \
     typing/subst.cmi \
     typing/shape.cmi \
     typing/rec_check.cmi \
@@ -1549,7 +1546,6 @@ typing/typecore.cmx : \
     typing/types.cmx \
     typing/typedtree.cmx \
     typing/typedecl.cmx \
-    typing/type_immediacy.cmx \
     typing/subst.cmx \
     typing/shape.cmx \
     typing/rec_check.cmx \
@@ -1598,9 +1594,7 @@ typing/typedecl.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
     typing/typedecl_variance.cmi \
-    typing/typedecl_unboxed.cmi \
     typing/typedecl_separability.cmi \
-    typing/typedecl_immediacy.cmi \
     typing/type_immediacy.cmi \
     typing/subst.cmi \
     typing/printtyp.cmi \
@@ -1633,9 +1627,7 @@ typing/typedecl.cmx : \
     typing/types.cmx \
     typing/typedtree.cmx \
     typing/typedecl_variance.cmx \
-    typing/typedecl_unboxed.cmx \
     typing/typedecl_separability.cmx \
-    typing/typedecl_immediacy.cmx \
     typing/type_immediacy.cmx \
     typing/subst.cmx \
     typing/printtyp.cmx \
@@ -1667,7 +1659,7 @@ typing/typedecl.cmi : \
     typing/typedtree.cmi \
     typing/typedecl_variance.cmi \
     typing/typedecl_separability.cmi \
-    typing/typedecl_immediacy.cmi \
+    typing/type_immediacy.cmi \
     typing/path.cmi \
     parsing/parsetree.cmi \
     parsing/longident.cmi \
@@ -1677,29 +1669,6 @@ typing/typedecl.cmi : \
     typing/errortrace.cmi \
     typing/env.cmi \
     parsing/asttypes.cmi
-typing/typedecl_immediacy.cmo : \
-    typing/types.cmi \
-    typing/typedecl_unboxed.cmi \
-    typing/typedecl_properties.cmi \
-    typing/type_immediacy.cmi \
-    parsing/location.cmi \
-    typing/ctype.cmi \
-    typing/typedecl_immediacy.cmi
-typing/typedecl_immediacy.cmx : \
-    typing/types.cmx \
-    typing/typedecl_unboxed.cmx \
-    typing/typedecl_properties.cmx \
-    typing/type_immediacy.cmx \
-    parsing/location.cmx \
-    typing/ctype.cmx \
-    typing/typedecl_immediacy.cmi
-typing/typedecl_immediacy.cmi : \
-    typing/types.cmi \
-    typing/typedecl_properties.cmi \
-    typing/type_immediacy.cmi \
-    parsing/location.cmi \
-    typing/ident.cmi \
-    typing/env.cmi
 typing/typedecl_properties.cmo : \
     typing/types.cmi \
     typing/ident.cmi \
@@ -1740,19 +1709,6 @@ typing/typedecl_separability.cmi : \
     parsing/location.cmi \
     typing/ident.cmi \
     typing/env.cmi
-typing/typedecl_unboxed.cmo : \
-    typing/types.cmi \
-    typing/env.cmi \
-    typing/ctype.cmi \
-    typing/typedecl_unboxed.cmi
-typing/typedecl_unboxed.cmx : \
-    typing/types.cmx \
-    typing/env.cmx \
-    typing/ctype.cmx \
-    typing/typedecl_unboxed.cmi
-typing/typedecl_unboxed.cmi : \
-    typing/types.cmi \
-    typing/env.cmi
 typing/typedecl_variance.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
@@ -1917,8 +1873,6 @@ typing/typemod.cmi : \
 typing/typeopt.cmo : \
     typing/types.cmi \
     typing/typedtree.cmi \
-    typing/typedecl_unboxed.cmi \
-    typing/type_immediacy.cmi \
     typing/predef.cmi \
     typing/path.cmi \
     utils/numbers.cmi \
@@ -1928,14 +1882,11 @@ typing/typeopt.cmo : \
     typing/env.cmi \
     typing/ctype.cmi \
     utils/config.cmi \
-    utils/clflags.cmi \
     parsing/asttypes.cmi \
     typing/typeopt.cmi
 typing/typeopt.cmx : \
     typing/types.cmx \
     typing/typedtree.cmx \
-    typing/typedecl_unboxed.cmx \
-    typing/type_immediacy.cmx \
     typing/predef.cmx \
     typing/path.cmx \
     utils/numbers.cmx \
@@ -1945,7 +1896,6 @@ typing/typeopt.cmx : \
     typing/env.cmx \
     typing/ctype.cmx \
     utils/config.cmx \
-    utils/clflags.cmx \
     parsing/asttypes.cmi \
     typing/typeopt.cmi
 typing/typeopt.cmi : \

.github/workflows/build.yml

@@ -22,7 +22,7 @@ jobs:
             ocamlrunparam: "v=0,V=1"
 
           - name: i386
-            config: CC='cc32' AS='as --32' ASPP='gcc -m32 -c' -host i386-linux PARTIALLD='ld -r -melf_i386'
+            config: --enable-stack-allocation=no CC='cc32' AS='as --32' ASPP='gcc -m32 -c' -host i386-linux PARTIALLD='ld -r -melf_i386'
             os: ubuntu-20.04
             ocamlparam: ''
             boot_config: CC='cc32' AS='as --32' ASPP='gcc -m32 -c' -host i386-linux PARTIALLD='ld -r -melf_i386'

compilerlibs/Makefile.compilerlibs

@@ -115,8 +115,6 @@ TYPING = \
   typing/parmatch.cmo \
   typing/typedecl_properties.cmo \
   typing/typedecl_variance.cmo \
-  typing/typedecl_unboxed.cmo \
-  typing/typedecl_immediacy.cmo \
   typing/typedecl_separability.cmo \
   lambda/debuginfo.cmo lambda/lambda.cmo \
   typing/typedecl.cmo \

configure.ac

@@ -2037,8 +2037,11 @@ AS_IF([test x"$DEFAULT_STRING" = "xunsafe"],
 
 AS_IF([test x"$enable_stack_allocation" = "xno"],
   [stack_allocation=false],
-  [AC_DEFINE([STACK_ALLOCATION])
-   stack_allocation=true])
+  [AS_IF([$arch64],
+    [AC_DEFINE([STACK_ALLOCATION])
+     stack_allocation=true],
+    [AC_MSG_ERROR([Stack allocation is only supported on 64-bit platforms. \
+Please pass '--enable-stack-allocation=no'.])])])
 
 AS_IF([test x"$enable_poll_insertion" = "xyes"],
   [AC_DEFINE([POLL_INSERTION])

dune

@@ -80,8 +80,8 @@
    includemod includemod_errorprinter
    typetexp patterns printpat parmatch stypes typedecl typeopt rec_check
    typecore
-   typeclass typemod typedecl_variance typedecl_properties typedecl_immediacy
-   typedecl_unboxed typedecl_separability cmt2annot
+   typeclass typemod typedecl_variance typedecl_properties
+   typedecl_separability cmt2annot
    ; manual update: mli only files
    annot outcometree
 
@@ -307,8 +307,6 @@
     (typemod.mli as compiler-libs/typemod.mli)
     (typedecl_variance.mli as compiler-libs/typedecl_variance.mli)
     (typedecl_properties.mli as compiler-libs/typedecl_properties.mli)
-    (typedecl_immediacy.mli as compiler-libs/typedecl_immediacy.mli)
-    (typedecl_unboxed.mli as compiler-libs/typedecl_unboxed.mli)
     (typedecl_separability.mli as compiler-libs/typedecl_separability.mli)
     (annot.mli as compiler-libs/annot.mli)
     (outcometree.mli as compiler-libs/outcometree.mli)

ocamldoc/odoc_sig.ml

@@ -371,7 +371,7 @@ module Analyser =
 
     let get_type_kind env name_comment_list type_kind =
       match type_kind with
-        Types.Type_abstract ->
+        Types.Type_abstract _ ->
           Odoc_type.Type_abstract
       | Types.Type_variant (l,_) ->
           let f {Types.cd_id=constructor_name;cd_args;cd_res=ret_type} =

testsuite/tests/typing-immediate/immediate.ml

@@ -24,6 +24,15 @@ module A = struct
   (* Mutually recursive declarations work as well *)
   type p = q [@@immediate]
   and q = int
+
+  (* Variants with only constant constructors are immediate *)
+  type o = Foo | Bar | Baz [@@immediate]
+
+  (* Can declare with a weaker immediacy than necessary *)
+  type m = int [@@immediate64]
+
+  (* ... and yet use the stronger one by expansion later *)
+  type n = m [@@immediate]
 end;;
 [%%expect{|
 module A :
@@ -33,6 +42,9 @@ module A :
     type r = s
     type p = q [@@immediate]
     and q = int
+    type o = Foo | Bar | Baz
+    type m = int [@@immediate64]
+    type n = m [@@immediate]
   end
 |}];;
 
@@ -60,6 +72,22 @@ module Empty_valid : S = struct type t = | end;;
 module Empty_valid : S
 |}];;
 
+(* Valid when unboxed *)
+module Unboxed_valid = struct
+  type t = { x : int } [@@unboxed] [@@immediate]
+
+  type u = { x : s } [@@unboxed] [@@immediate]
+  and s = int
+end;;
+[%%expect{|
+module Unboxed_valid :
+  sig
+    type t = { x : int; } [@@unboxed]
+    type u = { x : s; } [@@unboxed]
+    and s = int
+  end
+|}];;
+
 (* Practical usage over modules *)
 module Foo : sig type t val x : t ref end = struct
   type t = int
@@ -119,6 +147,30 @@ Error: Types marked with the immediate attribute must be non-pointer types
        like int or bool.
 |}];;
 
+(* Cannot directly declare a non-immediate type as immediate (variant) *)
+module B = struct
+  type t = Foo of int | Bar [@@immediate]
+end;;
+[%%expect{|
+Line 2, characters 2-41:
+2 |   type t = Foo of int | Bar [@@immediate]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Types marked with the immediate attribute must be non-pointer types
+       like int or bool.
+|}];;
+
+(* Cannot directly declare a non-immediate type as immediate (record) *)
+module B = struct
+  type t = { foo : int } [@@immediate]
+end;;
+[%%expect{|
+Line 2, characters 2-38:
+2 |   type t = { foo : int } [@@immediate]
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Types marked with the immediate attribute must be non-pointer types
+       like int or bool.
+|}];;
+
 (* Not guaranteed that t is immediate, so this is an invalid declaration *)
 module C = struct
   type t
@@ -181,3 +233,53 @@ Line 2, characters 2-26:
 Error: Types marked with the immediate attribute must be non-pointer types
        like int or bool.
 |}];;
+
+
+(* Aliases should be expanded to check immediacy *)
+type 'a id = 'a
+type s = int id [@@immediate]
+[%%expect{|
+type 'a id = 'a
+type s = int id [@@immediate]
+|}];;
+module F (X : sig type t end) = X
+module I = struct type t = int end
+type t = F(I).t [@@immediate]
+[%%expect{|
+module F : functor (X : sig type t end) -> sig type t = X.t end
+module I : sig type t = int end
+type t = F(I).t [@@immediate]
+|}];;
+module F (X : sig type t end) = X
+module I : sig type t = private int end = struct type t = int end
+type t = F(I).t [@@immediate]
+[%%expect{|
+module F : functor (X : sig type t end) -> sig type t = X.t end
+module I : sig type t = private int end
+type t = F(I).t [@@immediate]
+|}];;
+module type T = sig type t type s = t end
+module F (X : T with type t = int) = struct
+  type t = X.s [@@immediate]
+end
+[%%expect{|
+module type T = sig type t type s = t end
+module F :
+  functor (X : sig type t = int type s = t end) ->
+    sig type t = X.s [@@immediate] end
+|}];;
+module type T = sig type t type s = t end
+module F (X : T with type t = private int) = struct
+  type t = X.s [@@immediate]
+end
+[%%expect{|
+module type T = sig type t type s = t end
+module F :
+  functor (X : sig type t = private int type s = t end) ->
+    sig type t = X.s [@@immediate] end
+|}];;
+type t = int s [@@immediate] and 'a s = 'a
+[%%expect{|
+type t = int s [@@immediate]
+and 'a s = 'a
+|}];;

toplevel/genprintval.ml

@@ -366,9 +366,9 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
               try
                 let decl = Env.find_type path env in
                 match decl with
-                | {type_kind = Type_abstract; type_manifest = None} ->
+                | {type_kind = Type_abstract _; type_manifest = None} ->
                     Oval_stuff "<abstr>"
-                | {type_kind = Type_abstract; type_manifest = Some body} ->
+                | {type_kind = Type_abstract _; type_manifest = Some body} ->
                     tree_of_val depth obj
                       (instantiate_type env decl.type_params ty_list body)
                 | {type_kind = Type_variant (constr_list,rep)} ->

typing/btype.ml

@@ -324,7 +324,7 @@ let map_type_expr_cstr_args f = function
       Cstr_record (List.map (fun d -> {d with ld_type=f d.ld_type}) lbls)
 
 let iter_type_expr_kind f = function
-  | Type_abstract -> ()
+  | Type_abstract _ -> ()
   | Type_variant (cstrs, _) ->
       List.iter
         (fun cd ->