Define BoolVal patterns and true/false singleton vals

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

@@ -15,6 +15,8 @@ module Unison.Runtime.ANF
     pattern TApv,
     pattern TCom,
     pattern TCon,
+    pattern UFalse,
+    pattern UTrue,
     pattern TKon,
     pattern TReq,
     pattern TPrm,
@@ -1742,9 +1744,13 @@ anfHandled body =
         cc = case l of T {} -> BX; LM {} -> BX; LY {} -> BX; _ -> UN
     p -> pure p
 
-fls, tru :: (Var v) => ANormal v
-fls = TCon Ty.booleanRef 0 []
-tru = TCon Ty.booleanRef 1 []
+pattern UFalse <- TCon ((== Ty.booleanRef) -> True) 0 []
+  where
+    UFalse = TCon Ty.booleanRef 0 []
+
+pattern UTrue <- TCon ((== Ty.booleanRef) -> True) 1 []
+  where
+    UTrue = TCon Ty.booleanRef 1 []
 
 -- Helper function for renaming a variable arising from a
 --   let v = u
@@ -1882,7 +1888,7 @@ anfBlock (And' l r) = do
   let tree =
         TMatch vl . MatchDataCover Ty.booleanRef $
           mapFromList
-            [ (0, ([], fls)),
+            [ (0, ([], UFalse)),
               (1, ([], tmr))
             ]
   pure (lctx, (Indirect () <> d, tree))
@@ -1892,7 +1898,7 @@ anfBlock (Or' l r) = do
   let tree =
         TMatch vl . MatchDataCover Ty.booleanRef $
           mapFromList
-            [ (1, ([], tru)),
+            [ (1, ([], UTrue)),
               (0, ([], tmr))
             ]
   pure (lctx, (Indirect () <> d, tree))

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

@@ -40,10 +40,13 @@ module Unison.Runtime.Stack
         NatVal,
         DoubleVal,
         IntVal,
+        BoolVal,
         UnboxedVal,
         BoxedVal
       ),
     emptyVal,
+    falseVal,
+    trueVal,
     boxedVal,
     USeq,
     traceK,
@@ -140,6 +143,7 @@ import Unison.Runtime.ANF (PackedTag)
 import Unison.Runtime.Array
 import Unison.Runtime.Foreign
 import Unison.Runtime.MCode
+import Unison.Runtime.TypeTags qualified as TT
 import Unison.Type qualified as Ty
 import Unison.Util.EnumContainers as EC
 import Prelude hiding (words)
@@ -414,6 +418,25 @@ pattern IntVal i <- (matchIntVal -> Just i)
   where
     IntVal i = Val i intTypeTag
 
+matchBoolVal :: Val -> Maybe Bool
+matchBoolVal = \case
+  (BoxedVal (Enum r t)) | r == Ty.booleanRef -> Just (t == TT.falseTag)
+  _ -> Nothing
+
+pattern BoolVal :: Bool -> Val
+pattern BoolVal b <- (matchBoolVal -> Just b)
+  where
+    BoolVal b = if b then (BoxedVal (Enum Ty.booleanRef TT.trueTag)) else (BoxedVal (Enum Ty.booleanRef TT.trueTag))
+
+-- Define singletons we can use for the bools to prevent allocation where possible.
+falseVal :: Val
+falseVal = BoxedVal (Enum Ty.booleanRef TT.falseTag)
+{-# NOINLINE falseVal #-}
+
+trueVal :: Val
+trueVal = BoxedVal (Enum Ty.booleanRef TT.trueTag)
+{-# NOINLINE trueVal #-}
+
 doubleToInt :: Double -> Int
 doubleToInt d = indexByteArray (BA.byteArrayFromList [d]) 0
 {-# INLINE doubleToInt #-}

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

@@ -13,6 +13,8 @@ module Unison.Runtime.TypeTags
     unitTag,
     leftTag,
     rightTag,
+    falseTag,
+    trueTag,
   )
 where
 
@@ -126,6 +128,12 @@ charTag = mkSimpleTag "charTag" Ty.charRef
 unitTag :: PackedTag
 unitTag = mkSimpleTag "unitTag" Ty.unitRef
 
+falseTag :: PackedTag
+falseTag = mkEnumTag "falseTag" Ty.booleanRef 0
+
+trueTag :: PackedTag
+trueTag = mkEnumTag "trueTag" Ty.booleanRef 1
+
 leftTag, rightTag :: PackedTag
 (leftTag, rightTag)
   | Just n <- Map.lookup Ty.eitherRef builtinTypeNumbering,
@@ -137,8 +145,11 @@ leftTag, rightTag :: PackedTag
 
 -- | Construct a tag for a single-constructor builtin type
 mkSimpleTag :: String -> Reference -> PackedTag
-mkSimpleTag msg r
+mkSimpleTag msg r = mkEnumTag msg r 0
+
+mkEnumTag :: String -> Reference -> Int -> PackedTag
+mkEnumTag msg r i
   | Just n <- Map.lookup r builtinTypeNumbering,
     rt <- toEnum (fromIntegral n) =
-      packTags rt 0
+      packTags rt (toEnum i)
   | otherwise = internalBug $ "internal error: " <> msg