Inline builtin literal type reference tags

unison-runtime/src/Unison/Runtime/Builtin.hs

@@ -42,6 +42,7 @@ import Crypto.PubKey.Ed25519 qualified as Ed25519
 import Crypto.PubKey.RSA.PKCS15 qualified as RSA
 import Crypto.Random (getRandomBytes)
 import Data.Bits (shiftL, shiftR, (.|.))
+import Unison.Runtime.Builtin.TypeNumbering
 import Data.ByteArray qualified as BA
 import Data.ByteString (hGet, hGetSome, hPut)
 import Data.ByteString.Lazy qualified as L
@@ -3619,14 +3620,6 @@ verifyRsaWrapper (public0, msg0, sig0) = case validated of
     sig = Bytes.toArray sig0 :: ByteString
     validated = Rsa.parseRsaPublicKey (Bytes.toArray public0 :: ByteString)
 
-typeReferences :: [(Reference, Word64)]
-typeReferences = zip rs [1 ..]
-  where
-    rs =
-      [r | (_, r) <- Ty.builtinTypes]
-        ++ [DerivedId i | (_, i, _) <- Ty.builtinDataDecls]
-        ++ [DerivedId i | (_, i, _) <- Ty.builtinEffectDecls]
-
 foreignDeclResults ::
   Bool -> (Word64, [(Data.Text.Text, (Sandbox, SuperNormal Symbol))], EnumMap Word64 (Data.Text.Text, ForeignFunc))
 foreignDeclResults sanitize =
@@ -3647,9 +3640,6 @@ builtinTermBackref :: EnumMap Word64 Reference
 builtinTermBackref =
   mapFromList . zip [1 ..] . Map.keys $ builtinLookup
 
-builtinTypeNumbering :: Map Reference Word64
-builtinTypeNumbering = Map.fromList typeReferences
-
 builtinTypeBackref :: EnumMap Word64 Reference
 builtinTypeBackref = mapFromList $ swap <$> typeReferences
   where

unison-runtime/src/Unison/Runtime/Builtin/TypeNumbering.hs

@@ -0,0 +1,18 @@
+module Unison.Runtime.Builtin.TypeNumbering (typeReferences, builtinTypeNumbering) where
+
+import Data.Map qualified as Map
+import Unison.Builtin qualified as Ty (builtinTypes)
+import Unison.Builtin.Decls qualified as Ty
+import Unison.Prelude hiding (Text, some)
+import Unison.Reference
+
+builtinTypeNumbering :: Map Reference Word64
+builtinTypeNumbering = Map.fromList typeReferences
+
+typeReferences :: [(Reference, Word64)]
+typeReferences = zip rs [1 ..]
+  where
+    rs =
+      [r | (_, r) <- Ty.builtinTypes]
+        ++ [DerivedId i | (_, i, _) <- Ty.builtinDataDecls]
+        ++ [DerivedId i | (_, i, _) <- Ty.builtinEffectDecls]

unison-runtime/src/Unison/Runtime/MCode.hs

@@ -91,6 +91,7 @@ import Unison.Runtime.ANF
     pattern TVar,
   )
 import Unison.Runtime.ANF qualified as ANF
+import Unison.Runtime.Builtin.TypeNumbering (builtinTypeNumbering)
 import Unison.Util.EnumContainers as EC
 import Unison.Util.Text (Text)
 import Unison.Var (Var)
@@ -511,7 +512,7 @@ data GInstr comb
   | -- Push a particular value onto the appropriate stack
     Lit !MLit -- value to push onto the stack
   | -- Push a particular value directly onto the boxed stack
-    BLit !Reference !MLit
+    BLit !Reference !Word64 {- packed type tag for the ref -} !MLit
   | -- Print a value on the unboxed stack
     Print !Int -- index of the primitive value to print
   | -- Put a delimiter on the continuation
@@ -1487,8 +1488,18 @@ doubleToInt :: Double -> Int
 doubleToInt d = indexByteArray (byteArrayFromList [d]) 0
 
 emitBLit :: ANF.Lit -> Instr
-emitBLit l@(ANF.F d) = BLit (ANF.litRef l) (MI $ doubleToInt d)
-emitBLit l = BLit (ANF.litRef l) (litToMLit l)
+emitBLit l = case l of
+  (ANF.F d) -> BLit lRef builtinTypeTag (MI $ doubleToInt d)
+  _ -> BLit lRef builtinTypeTag (litToMLit l)
+  where
+    lRef = ANF.litRef l
+    builtinTypeTag :: Word64
+    builtinTypeTag =
+      case M.lookup (ANF.litRef l) builtinTypeNumbering of
+        Nothing -> error "emitBLit: unknown builtin type reference"
+        Just n ->
+          let rt = toEnum (fromIntegral n)
+           in (packTags rt 0)
 
 -- Emits some fix-up code for calling functions. Some of the
 -- variables in scope come from the top-level let rec, but these

unison-runtime/src/Unison/Runtime/MCode/Serialize.hs

@@ -183,7 +183,7 @@ putInstr pCix = \case
   (Pack r w a) -> putTag PackT *> putReference r *> pWord w *> putArgs a
   (Unpack mr i) -> putTag UnpackT *> putMaybe mr putReference *> pInt i
   (Lit l) -> putTag LitT *> putLit l
-  (BLit r l) -> putTag BLitT *> putReference r *> putLit l
+  (BLit r tt l) -> putTag BLitT *> putReference r *> putNat tt *> putLit l
   (Print i) -> putTag PrintT *> pInt i
   (Reset s) -> putTag ResetT *> putEnumSet pWord s
   (Fork i) -> putTag ForkT *> pInt i
@@ -206,7 +206,7 @@ getInstr gCix =
     PackT -> Pack <$> getReference <*> gWord <*> getArgs
     UnpackT -> Unpack <$> getMaybe getReference <*> gInt
     LitT -> Lit <$> getLit
-    BLitT -> BLit <$> getReference <*> getLit
+    BLitT -> BLit <$> getReference <*> getNat <*> getLit
     PrintT -> Print <$> gInt
     ResetT -> Reset <$> getEnumSet gWord
     ForkT -> Fork <$> gInt

unison-runtime/src/Unison/Runtime/Machine.hs

@@ -254,16 +254,12 @@ unitValue = Enum Rf.unitRef unitTag
 lookupDenv :: Word64 -> DEnv -> Closure
 lookupDenv p denv = fromMaybe BlackHole $ EC.lookup p denv
 
-buildLit :: Reference -> MLit -> Closure
-buildLit rf (MI i)
-  | Just n <- M.lookup rf builtinTypeNumbering,
-    rt <- toEnum (fromIntegral n) =
-      DataU1 rf (packTags rt 0) i
-  | otherwise = error "buildLit: unknown reference"
-buildLit _ (MT t) = Foreign (Wrap Rf.textRef t)
-buildLit _ (MM r) = Foreign (Wrap Rf.termLinkRef r)
-buildLit _ (MY r) = Foreign (Wrap Rf.typeLinkRef r)
-buildLit _ (MD _) = error "buildLit: double"
+buildLit :: Reference -> Word64 -> MLit -> Closure
+buildLit rf tt (MI i) = DataU1 rf tt i
+buildLit _ _ (MT t) = Foreign (Wrap Rf.textRef t)
+buildLit _ _ (MM r) = Foreign (Wrap Rf.termLinkRef r)
+buildLit _ _ (MY r) = Foreign (Wrap Rf.typeLinkRef r)
+buildLit _ _ (MD _) = error "buildLit: double"
 
 -- | Execute an instruction
 exec ::
@@ -504,9 +500,9 @@ exec !_ !denv !_activeThreads !ustk !bstk !k _ (Lit (MY r)) = do
   bstk <- bump bstk
   poke bstk (Foreign (Wrap Rf.typeLinkRef r))
   pure (denv, ustk, bstk, k)
-exec !_ !denv !_activeThreads !ustk !bstk !k _ (BLit rf l) = do
+exec !_ !denv !_activeThreads !ustk !bstk !k _ (BLit rf tt l) = do
   bstk <- bump bstk
-  poke bstk $ buildLit rf l
+  poke bstk $ buildLit rf tt l
   pure (denv, ustk, bstk, k)
 exec !_ !denv !_activeThreads !ustk !bstk !k _ (Reset ps) = do
   (ustk, ua) <- saveArgs ustk

unison-runtime/unison-runtime.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -33,6 +33,7 @@ library
       Unison.Runtime.ANF.Serialize
       Unison.Runtime.Array
       Unison.Runtime.Builtin
+      Unison.Runtime.Builtin.TypeNumbering
       Unison.Runtime.Crypto.Rsa
       Unison.Runtime.Debug
       Unison.Runtime.Decompile