Address comments

IntersectMBO · Apr 16, 2024 · 172d0e4 · 172d0e4
1 parent f823fce
commit 172d0e4
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 6 deletions.
diff --git a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.pir.golden b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.pir.golden
@@ -9,7 +9,7 @@ letrec
           {data}
           {Unit -> Unit -> data}
           xs
-          (\(ds : Unit) (eta : Unit) -> error {data})
+          (\(ds : Unit) -> error {Unit -> data})
           (\(ds : Unit) (ds : Unit) ->
              let
                !hd : data = headList {data} xs

diff --git a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden
@@ -6,7 +6,7 @@ program
            (\go i ->
               force (force chooseList)
                 x
-                (\ds eta -> error)
+                (\ds -> error)
                 (\ds ds ->
                    (\hd ->
                       (\tl ->

diff --git a/plutus-tx/src/PlutusTx/Builtins.hs b/plutus-tx/src/PlutusTx/Builtins.hs
@@ -69,6 +69,7 @@ module PlutusTx.Builtins (
                          , pairToPair
                          -- * Lists
                          , matchList
+                         , matchList'
                          , headMaybe
                          , BI.head
                          , BI.tail
@@ -384,17 +385,22 @@ encodeUtf8 :: BuiltinString -> BuiltinByteString
 encodeUtf8 = BI.encodeUtf8
 
 {-# INLINABLE matchList #-}
-matchList :: forall a r . BI.BuiltinList a -> r -> (a -> BI.BuiltinList a -> r) -> r
-matchList l nilCase consCase = BI.chooseList l (const nilCase) (\_ -> consCase (BI.head l) (BI.tail l)) ()
+matchList :: forall a r . BI.BuiltinList a -> (() -> r) -> (a -> BI.BuiltinList a -> r) -> r
+matchList l nilCase consCase = BI.chooseList l nilCase (\_ -> consCase (BI.head l) (BI.tail l)) ()
+
+{-# INLINABLE matchList' #-}
+-- | Like `matchList` but evaluates @nilCase@ strictly.
+matchList' :: forall a r . BI.BuiltinList a -> r -> (a -> BI.BuiltinList a -> r) -> r
+matchList' l nilCase consCase = BI.chooseList l (const nilCase) (\_ -> consCase (BI.head l) (BI.tail l)) ()
 
 {-# INLINE headMaybe #-}
 headMaybe :: BI.BuiltinList a -> Maybe a
-headMaybe l = matchList l Nothing (\h _ -> Just h)
+headMaybe l = matchList' l Nothing (\h _ -> Just h)
 
 {-# INLINE uncons #-}
 -- | Uncons a builtin list, failing if the list is empty, useful in patterns.
 uncons :: BI.BuiltinList a -> Maybe (a, BI.BuiltinList a)
-uncons l = matchList l Nothing (\h t -> Just (h, t))
+uncons l = matchList' l Nothing (\h t -> Just (h, t))
 
 {-# INLINE unsafeUncons #-}
 -- | Uncons a builtin list, failing if the list is empty, useful in patterns.