FSyntax: Add BoxedType and Box/Unbox primitives for WasmGC

Add BoxedType constructor to FSyntax.Ty and UnboxedTy datatype to
enumerate fixed-size primitive types. Add BoxOp/UnboxOp to PrimOp for
converting between boxed and unboxed representations. Update type
compatibility rules so that BoxedType is compatible with all types
except unboxed primitives.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>

Author: minoki

src/cps/check.sml

@@ -316,7 +316,21 @@ struct
                          (env, fn () => "LuaMethodNOp", F.Types.lua_value)) args
                   ; List.tabulate (n, fn _ => F.Types.lua_value)
                   )
-              | _ => raise TypeError "invalid LuaMethodNOp"))
+              | _ => raise TypeError "invalid LuaMethodNOp")
+         | F.BoxOp fsp =>
+             (case (tyargs, args) of
+                ([], [e]) =>
+                  ( checkValue (env, fn () => "BoxOp", F.unboxedTyToTy fsp) e
+                  ; [F.BoxedType]
+                  )
+              | _ => raise TypeError "invalid BoxOp")
+         | F.UnboxOp fsp =>
+             (case (tyargs, args) of
+                ([], [e]) =>
+                  ( checkValue (env, fn () => "UnboxOp", F.BoxedType) e
+                  ; [F.unboxedTyToTy fsp]
+                  )
+              | _ => raise TypeError "invalid UnboxOp"))
     | inferSimpleExp (env, C.Record fields) =
         [F.RecordType (Syntax.LabelMap.map (inferValue env) fields)]
     | inferSimpleExp (env as {tyEnv, ...}, C.ExnTag {name = _, payloadTy}) =
@@ -332,6 +346,7 @@ struct
                      ^ Printer.build (FPrinter.doTy 0 recordTy) ^ ", label="
                      ^ Syntax.print_Label label))
          | anyTy as F.AnyType F.TypeKind => [anyTy]
+         | F.BoxedType => [F.BoxedType]
          | recordTy =>
              raise Fail
                ("invalid record type for projection: "

src/cps/erase-poly.sml

@@ -38,6 +38,7 @@ struct
              F.AnyType kind2 => F.AnyType (F.ArrowKind (kind, kind2))
            | ty => F.TypeFn (tv, kind, goTy env ty))
       | goTy _ (ty as F.AnyType _) = ty
+      | goTy _ (ty as F.BoxedType) = ty
       | goTy env (ty as F.DelayedSubst _) =
           goTy env (F.forceTy ty)
     fun goValue ({valMap, ...}: env) (v as C.Var vid) =

src/cps/syntax.sml

@@ -320,6 +320,8 @@ struct
           isDiscardablePrimEffect e
       | isDiscardable (PrimOp {primOp = F.LuaMethodNOp _, args = [], ...}) =
           false (* should not occur *)
+      | isDiscardable (PrimOp {primOp = F.BoxOp _, ...}) = true
+      | isDiscardable (PrimOp {primOp = F.UnboxOp _, ...}) = true
       | isDiscardable (Record _) = true
       | isDiscardable (ExnTag _) = true
       | isDiscardable (Projection _) = true
@@ -661,7 +663,9 @@ struct
            | F.LuaCallNOp _ => "PrimOp(LuaCallNOp)"
            | F.LuaMethodOp _ => "PrimOp(LuaMethodOp)"
            | F.LuaMethod1Op _ => "PrimOp(LuaMethod1Op)"
-           | F.LuaMethodNOp _ => "PrimOp(LuaMethodNOp)")
+           | F.LuaMethodNOp _ => "PrimOp(LuaMethodNOp)"
+           | F.BoxOp _ => "PrimOp(BoxOp)"
+           | F.UnboxOp _ => "PrimOp(UnboxOp)")
       | simpleExpToString (Record _) = "Record"
       | simpleExpToString (ExnTag _) = "ExnTag"
       | simpleExpToString (Projection _) = "Projection"
@@ -734,6 +738,7 @@ struct
               | goTy (F.TypeFn (tv, kind, ty)) =
                   F.TypeFn (tv, kind, goTy ty)
               | goTy (ty as F.AnyType _) = ty
+              | goTy (ty as F.BoxedType) = ty
               | goTy (ty as F.DelayedSubst _) =
                   goTy (F.forceTy ty)
           in

src/cps/unpack-record-parameter.sml

@@ -353,6 +353,7 @@ in
                                SOME fieldTy => fieldTy
                              | NONE => raise Fail "missing field")
                         | anyTy as FSyntax.AnyType FSyntax.TypeKind => anyTy
+                        | boxedTy as FSyntax.BoxedType => boxedTy
                         | recordTy =>
                             raise Fail
                               ("invalid record type: "
@@ -391,6 +392,7 @@ in
                                   | NONE => raise Fail "missing field")
                              | anyTy as FSyntax.AnyType FSyntax.TypeKind =>
                                  anyTy
+                             | boxedTy as FSyntax.BoxedType => boxedTy
                              | recordTy =>
                                  raise Fail
                                    ("invalid record type: "

src/f/check.sml

@@ -77,6 +77,7 @@ struct
           F.ArrowKind
             (kind, kindOf (TypedSyntax.TyVarMap.insert (env, tv, kind)) ty)
       | kindOf _ (F.AnyType kind) = kind
+      | kindOf _ F.BoxedType = F.TypeKind
       | kindOf env (ty as F.DelayedSubst _) =
           kindOf env (F.forceTy ty)
     and checkKind (env, expectedKind) ty =
@@ -135,6 +136,7 @@ struct
       | normalizeType env (F.TypeFn (tv, kind, ty)) =
           F.TypeFn (tv, kind, normalizeType env ty)
       | normalizeType _ (ty as F.AnyType _) = ty
+      | normalizeType _ (ty as F.BoxedType) = ty
       | normalizeType env (ty as F.DelayedSubst _) =
           normalizeType env (F.forceTy ty)
 
@@ -206,6 +208,11 @@ struct
           end
       | sameType'' _ (F.AnyType _, _) = true
       | sameType'' _ (_, F.AnyType _) = true
+      | sameType'' _ (F.BoxedType, F.BoxedType) = true
+      | sameType'' _ (F.BoxedType, ty) =
+          not (F.isUnboxedTy ty)
+      | sameType'' _ (ty, F.BoxedType) =
+          not (F.isUnboxedTy ty)
       | sameType'' _ _ = false
     (*: val sameType : F.Ty * F.Ty -> bool *)
     val sameType =
@@ -602,6 +609,10 @@ struct
             List.app (fn a => checkExp (env, F.Types.lua_value, a)) args;
             loop (n, Syntax.LabelMap.empty)
           end
+      | inferExp (env, F.PrimExp (F.BoxOp fsp, [], [e])) =
+          (checkExp (env, F.unboxedTyToTy fsp, e); F.BoxedType)
+      | inferExp (env, F.PrimExp (F.UnboxOp fsp, [], [e])) =
+          (checkExp (env, F.BoxedType, e); F.unboxedTyToTy fsp)
       | inferExp (_, F.PrimExp (p, _, _)) =
           raise TypeError
             ("PrimOp with invalid arguments: "

src/f/printer.sml

@@ -69,6 +69,7 @@ struct
            doTyVar tv
            @ P.Fragment " : " :: doKind 0 kind @ P.Fragment ". " :: doTy 0 ty)
     | doTy _ (F.AnyType _) = [P.Fragment "Any"]
+    | doTy _ F.BoxedType = [P.Fragment "Boxed"]
     | doTy prec (ty as F.DelayedSubst _) =
         doTy prec (F.forceTy ty)
   fun doPrimOp (F.IntConstOp x) =
@@ -137,6 +138,8 @@ struct
     | doPrimOp (F.LuaMethodOp _) = [P.Fragment "LuaMethod"]
     | doPrimOp (F.LuaMethod1Op _) = [P.Fragment "LuaMethod1"]
     | doPrimOp (F.LuaMethodNOp _) = [P.Fragment "LuaMethodN"]
+    | doPrimOp (F.BoxOp _) = [P.Fragment "Box"]
+    | doPrimOp (F.UnboxOp _) = [P.Fragment "Unbox"]
   fun doPat _ (F.WildcardPat _) = [P.Fragment "_"]
     | doPat _ (F.SConPat {scon = F.IntegerConstant x, ...}) =
         [P.Fragment (IntInf.toString x)]

src/f/syntax.sml

@@ -15,12 +15,23 @@ sig
   | ExistsType of TyVar * Kind * Ty
   | TypeFn of TyVar * Kind * Ty (* type-level function *)
   | AnyType of Kind (* erased type *)
+  | BoxedType (* boxed value type *)
   | DelayedSubst of DelayedSubst ref
   and DelayedSubst =
     UnevaluatedSubst of Ty TypedSyntax.TyVarMap.map * Ty
   | EvaluatedSubst of Ty
   datatype ConBind = ConBind of TypedSyntax.VId * Ty option
   datatype DatBind = DatBind of TyVar list * TyVar * ConBind list
+  datatype UnboxedTy =
+    UBTyInt32
+  | UBTyInt64
+  | UBTyWord32
+  | UBTyWord64
+  | UBTyReal
+  | UBTyChar
+  | UBTyChar16
+  | UBTyChar32
+  | UBTyBool
   datatype PrimOp =
     IntConstOp of IntInf.int (* 1 type argument *)
   | WordConstOp of IntInf.int (* 1 type argument *)
@@ -63,6 +74,8 @@ sig
   | LuaMethodNOp of
       string
       * int (* returnArity (int), value argument: prim_effect, object, arguments *)
+  | BoxOp of UnboxedTy (* 0 type args, 1 value arg *)
+  | UnboxOp of UnboxedTy (* 0 type args, 1 value arg *)
   datatype PatternSCon =
     IntegerConstant of IntInf.int
   | WordConstant of IntInf.int
@@ -201,10 +214,13 @@ sig
     val lua_value: Ty
     val js_value: Ty
     val prim_effect: Ty
+    val boxed: Ty
     val list: Ty -> Ty
     val vector: Ty -> Ty
     val array: Ty -> Ty
   end
+  val isUnboxedTy: Ty -> bool
+  val unboxedTyToTy: UnboxedTy -> Ty
   val AsciiStringAsDatatypeTag: TargetInfo.target_info * string -> Exp
   val strIdToVId: TypedSyntax.StrId -> TypedSyntax.VId
   val SimplifyingAndalsoExp: Exp * Exp -> Exp
@@ -257,12 +273,23 @@ struct
   | ExistsType of TyVar * Kind * Ty
   | TypeFn of TyVar * Kind * Ty (* type-level function *)
   | AnyType of Kind (* erased type *)
+  | BoxedType (* boxed value type *)
   | DelayedSubst of DelayedSubst ref
   and DelayedSubst =
     UnevaluatedSubst of Ty TypedSyntax.TyVarMap.map * Ty
   | EvaluatedSubst of Ty
   datatype ConBind = ConBind of TypedSyntax.VId * Ty option
   datatype DatBind = DatBind of TyVar list * TyVar * ConBind list
+  datatype UnboxedTy =
+    UBTyInt32
+  | UBTyInt64
+  | UBTyWord32
+  | UBTyWord64
+  | UBTyReal
+  | UBTyChar
+  | UBTyChar16
+  | UBTyChar32
+  | UBTyBool
   datatype PrimOp =
     IntConstOp of IntInf.int (* 1 type argument *)
   | WordConstOp of IntInf.int (* 1 type argument *)
@@ -305,6 +332,8 @@ struct
   | LuaMethodNOp of
       string
       * int (* returnArity (int), value argument: prim_effect, object, arguments *)
+  | BoxOp of UnboxedTy (* 0 type args, 1 value arg *)
+  | UnboxOp of UnboxedTy (* 0 type args, 1 value arg *)
   datatype PatternSCon =
     IntegerConstant of IntInf.int
   | WordConstant of IntInf.int
@@ -447,13 +476,34 @@ struct
     val lua_value = TyVar PrimTypes.Names.lua_value
     val js_value = TyVar PrimTypes.Names.js_value
     val prim_effect = TyVar PrimTypes.Names.prim_effect
+    val boxed = BoxedType
     fun list ty =
       AppType {applied = TyVar PrimTypes.Names.list, arg = ty}
     fun vector ty =
       AppType {applied = TyVar PrimTypes.Names.vector, arg = ty}
     fun array ty =
       AppType {applied = TyVar PrimTypes.Names.array, arg = ty}
   end
+  fun unboxedTyToTy UBTyInt32 = Types.int32
+    | unboxedTyToTy UBTyInt64 = Types.int64
+    | unboxedTyToTy UBTyWord32 = Types.word32
+    | unboxedTyToTy UBTyWord64 = Types.word64
+    | unboxedTyToTy UBTyReal = Types.real
+    | unboxedTyToTy UBTyChar = Types.char
+    | unboxedTyToTy UBTyChar16 = Types.char16
+    | unboxedTyToTy UBTyChar32 = Types.char32
+    | unboxedTyToTy UBTyBool = Types.bool
+  fun isUnboxedTy (TyVar tv) =
+        TypedSyntax.eqTyVar (tv, PrimTypes.Names.int32)
+        orelse TypedSyntax.eqTyVar (tv, PrimTypes.Names.int64)
+        orelse TypedSyntax.eqTyVar (tv, PrimTypes.Names.word32)
+        orelse TypedSyntax.eqTyVar (tv, PrimTypes.Names.word64)
+        orelse TypedSyntax.eqTyVar (tv, PrimTypes.Names.real)
+        orelse TypedSyntax.eqTyVar (tv, PrimTypes.Names.char)
+        orelse TypedSyntax.eqTyVar (tv, PrimTypes.Names.char16)
+        orelse TypedSyntax.eqTyVar (tv, PrimTypes.Names.char32)
+        orelse TypedSyntax.eqTyVar (tv, PrimTypes.Names.bool)
+    | isUnboxedTy _ = false
   fun FnType (param, result) =
     MultiFnType ([param], result)
   fun TupleType xs =
@@ -575,6 +625,7 @@ struct
               TypeFn (tv, kind, ty)
             end
         | go subst (ty as AnyType _) = ty
+        | go subst (ty as BoxedType) = ty
         | go subst (DelayedSubst r) =
             (case !r of
                EvaluatedSubst ty => go subst ty
@@ -601,6 +652,7 @@ struct
                NONE => ty
              | SOME replacement => replacement)
         | lazySubstTy subst (ty as AnyType _) = ty
+        | lazySubstTy subst (ty as BoxedType) = ty
         | lazySubstTy subst ty =
             if TypedSyntax.TyVarMap.isEmpty subst then ty
             else DelayedSubst (ref (UnevaluatedSubst (subst, ty)))
@@ -630,6 +682,7 @@ struct
         | go subst (TypeFn (tv, kind, ty)) =
             TypeFn (tv, kind, lazySubstTy subst ty)
         | go subst (ty as AnyType _) = ty
+        | go subst (ty as BoxedType) = ty
         | go subst (DelayedSubst r) =
             (case !r of
                EvaluatedSubst ty => go subst ty
@@ -660,6 +713,7 @@ struct
     | weakNormalizeTy (ty as ExistsType _) = ty
     | weakNormalizeTy (ty as TypeFn _) = ty
     | weakNormalizeTy (ty as AnyType _) = ty
+    | weakNormalizeTy (ty as BoxedType) = ty
     | weakNormalizeTy (ty as DelayedSubst _) =
         substAndWeakNormalizeTy TypedSyntax.TyVarMap.empty ty
 
@@ -678,6 +732,7 @@ struct
         | check (TypeFn (tv', _, ty)) =
             if TypedSyntax.eqTyVar (tv, tv') then false else check ty
         | check (AnyType _) = false
+        | check BoxedType = false
         | check (ty as DelayedSubst _) =
             check (forceTy ty)
     in
@@ -700,6 +755,7 @@ struct
         | go (TypeFn (TypedSyntax.MkTyVar (_, i), _, ty), j) =
             go (ty, Int.min (i, j))
         | go (AnyType _, i) = i
+        | go (BoxedType, i) = i
         | go (ty as DelayedSubst _, i) =
             go (forceTy ty, i)
     in
@@ -752,6 +808,7 @@ struct
             else
               TypeFn (tv', kind, go ty')
         | go (ty as AnyType _) = ty
+        | go (ty as BoxedType) = ty
         | go (ty as DelayedSubst _) =
             go (forceTy ty)
     in
@@ -772,6 +829,7 @@ struct
         | isRelevant (ExistsType (_, _, ty)) = isRelevant ty (* approximation *)
         | isRelevant (TypeFn (_, _, ty)) = isRelevant ty (* approximation *)
         | isRelevant (AnyType _) = false
+        | isRelevant BoxedType = false
         | isRelevant (DelayedSubst _) = true (* conservative *)
       fun doTy (ty as TyVar tv) =
             (case TypedSyntax.TyVarMap.find (subst, tv) of
@@ -848,6 +906,7 @@ struct
                ) (* TODO: use fresh tyvar if necessary *)
          | NONE => TypeFn (tv, kind, doTy ty)) *)
         | doTy (ty as AnyType _) = ty
+        | doTy (ty as BoxedType) = ty
         | doTy (ty as DelayedSubst _) = substAndForceTy subst ty
       val doTy = fn ty =>
         if isRelevant ty then doTy ty else ty (* optimization *)
@@ -1022,6 +1081,7 @@ struct
                NONE => ty
              | SOME replacement => replacement)
         | doTy (ty as AnyType _) = ty
+        | doTy (ty as BoxedType) = ty
         | doTy ty =
             DelayedSubst (ref (UnevaluatedSubst (subst, ty)))
       val doTy =
@@ -1207,6 +1267,7 @@ struct
     | freeTyVarsInTy (bound, TypeFn (tv, _, ty)) acc =
         freeTyVarsInTy (TypedSyntax.TyVarSet.add (bound, tv), ty) acc
     | freeTyVarsInTy (_, AnyType _) acc = acc
+    | freeTyVarsInTy (_, BoxedType) acc = acc
     | freeTyVarsInTy (bound, ty as DelayedSubst _) acc =
         freeTyVarsInTy (bound, forceTy ty) acc
   fun freeTyVarsInPat (_, WildcardPat _) acc = acc
@@ -1616,6 +1677,7 @@ struct
       | print_Ty (TypeFn (tv, _, x)) =
           "TypeFn(" ^ print_TyVar tv ^ "," ^ print_Ty x ^ ")"
       | print_Ty (AnyType _) = "AnyType"
+      | print_Ty BoxedType = "BoxedType"
       | print_Ty (ty as DelayedSubst _) =
           print_Ty (forceTy ty)
     fun print_PrimOp (IntConstOp x) = "IntConstOp " ^ IntInf.toString x
@@ -1674,6 +1736,19 @@ struct
       | print_PrimOp (LuaMethodOp _) = "LuaMethodOp"
       | print_PrimOp (LuaMethod1Op _) = "LuaMethod1Op"
       | print_PrimOp (LuaMethodNOp _) = "LuaMethodNOp"
+      | print_PrimOp (BoxOp fsp) =
+          "BoxOp(" ^ print_UnboxedTy fsp ^ ")"
+      | print_PrimOp (UnboxOp fsp) =
+          "UnboxOp(" ^ print_UnboxedTy fsp ^ ")"
+    and print_UnboxedTy UBTyInt32 = "Int32"
+      | print_UnboxedTy UBTyInt64 = "Int64"
+      | print_UnboxedTy UBTyWord32 = "Word32"
+      | print_UnboxedTy UBTyWord64 = "Word64"
+      | print_UnboxedTy UBTyReal = "Real"
+      | print_UnboxedTy UBTyChar = "Char"
+      | print_UnboxedTy UBTyChar16 = "Char16"
+      | print_UnboxedTy UBTyChar32 = "Char32"
+      | print_UnboxedTy UBTyBool = "Bool"
     fun print_Pat (WildcardPat _) = "WildcardPat"
       | print_Pat
           (SConPat

src/f/transform.sml

@@ -716,6 +716,8 @@ struct
     | isDiscardablePrimOp (F.LuaMethodOp _) = false
     | isDiscardablePrimOp (F.LuaMethod1Op _) = false
     | isDiscardablePrimOp (F.LuaMethodNOp _) = false
+    | isDiscardablePrimOp (F.BoxOp _) = true
+    | isDiscardablePrimOp (F.UnboxOp _) = true
   fun isDiscardable (F.PrimExp (primOp, _, args)) =
         isDiscardablePrimOp primOp andalso List.all isDiscardable args
     | isDiscardable (F.VarExp _) = true