diff --git a/plutus-core/plutus-core.cabal b/plutus-core/plutus-core.cabal index 6f8410757b3..9b013cd9203 100644 --- a/plutus-core/plutus-core.cabal +++ b/plutus-core/plutus-core.cabal @@ -332,6 +332,7 @@ library , semigroups >=0.19.1 , serialise , some + , strict-base , template-haskell , text , th-compat diff --git a/plutus-core/plutus-core/src/PlutusCore/Compiler/Erase.hs b/plutus-core/plutus-core/src/PlutusCore/Compiler/Erase.hs index 6dd766d58f8..00ba7e5a8bc 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Compiler/Erase.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Compiler/Erase.hs @@ -1,6 +1,7 @@ module PlutusCore.Compiler.Erase (eraseTerm, eraseProgram) where import Data.Vector (fromList) +import GHC.IsList qualified as GHC import PlutusCore.Core import PlutusCore.Name.Unique import UntypedPlutusCore.Core qualified as UPLC @@ -24,8 +25,8 @@ eraseTerm (TyInst ann term _) = UPLC.Force ann (eraseTerm term) eraseTerm (Unwrap _ term) = eraseTerm term eraseTerm (IWrap _ _ _ term) = eraseTerm term eraseTerm (Error ann _) = UPLC.Error ann -eraseTerm (Constr ann _ i args) = UPLC.Constr ann i (fmap eraseTerm args) -eraseTerm (Case ann _ arg cs) = UPLC.Case ann (eraseTerm arg) (fromList $ fmap eraseTerm cs) +eraseTerm (Constr ann _ i args) = UPLC.Constr ann i (GHC.fromList $ map eraseTerm args) +eraseTerm (Case ann _ arg cs) = UPLC.Case ann (eraseTerm arg) (fromList $ map eraseTerm cs) eraseProgram :: HasUnique name TermUnique => Program tyname name uni fun ann diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Eq.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Eq.hs index 64d617ad9d0..8f9fde915fd 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Eq.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Eq.hs @@ -99,7 +99,7 @@ eqTermM (Error ann1) (Error ann2) = eqM ann1 ann2 eqTermM (Constr ann1 i1 args1) (Constr ann2 i2 args2) = do eqM ann1 ann2 eqM i1 i2 - case zipExact args1 args2 of + case zipExact (toList args1) (toList args2) of Just ps -> for_ ps $ \(t1, t2) -> eqTermM t1 t2 Nothing -> empty eqTermM (Case ann1 a1 cs1) (Case ann2 a2 cs2) = do diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Flat.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Flat.hs index 307163b5907..41251b297bb 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Flat.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Flat.hs @@ -24,6 +24,7 @@ import Flat import Flat.Decoder import Flat.Encoder import Flat.Encoder.Strict (sizeListWith) +import GHC.IsList qualified as GHC import Universe {- @@ -122,7 +123,7 @@ encodeTerm = \case Force ann t -> encodeTermTag 5 <> encode ann <> encodeTerm t Error ann -> encodeTermTag 6 <> encode ann Builtin ann bn -> encodeTermTag 7 <> encode ann <> encode bn - Constr ann i es -> encodeTermTag 8 <> encode ann <> encode i <> encodeListWith encodeTerm es + Constr ann i es -> encodeTermTag 8 <> encode ann <> encode i <> encodeListWith encodeTerm (GHC.toList es) Case ann arg cs -> encodeTermTag 9 <> encode ann <> encodeTerm arg <> encodeListWith encodeTerm (V.toList cs) decodeTerm @@ -157,7 +158,7 @@ decodeTerm version builtinPred = go Just e -> fail e handleTerm 8 = do unless (version >= PLC.plcVersion110) $ fail $ "'constr' is not allowed before version 1.1.0, this program has version: " ++ (show $ pretty version) - Constr <$> decode <*> decode <*> decodeListWith go + Constr <$> decode <*> decode <*> (GHC.fromList <$> decodeListWith go) handleTerm 9 = do unless (version >= PLC.plcVersion110) $ fail $ "'case' is not allowed before version 1.1.0, this program has version: " ++ (show $ pretty version) Case <$> decode <*> go <*> (V.fromList <$> decodeListWith go) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Classic.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Classic.hs index 0373e323608..a444637fe53 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Classic.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Classic.hs @@ -46,7 +46,7 @@ instance (PrettyClassicBy configName name, PrettyUni uni, Pretty fun, Pretty ann sexp "force" (consAnnIf config ann [prettyBy config term]) Constr ann i es -> - sexp "constr" (consAnnIf config ann (pretty i : fmap (prettyBy config) es)) + sexp "constr" (consAnnIf config ann (pretty i : fmap (prettyBy config) (toList es))) Case ann arg cs -> sexp "case" (consAnnIf config ann (prettyBy config arg : fmap (prettyBy config) (toList cs))) diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Readable.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Readable.hs index 681d1c81ea6..754fff20e9a 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Readable.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Readable.hs @@ -51,7 +51,7 @@ instance -- Always rendering the tag on the same line for more compact output, it's just a tiny integer -- anyway. Constr _ i es -> iterAppDocM $ \_ prettyArg -> - ("constr" <+> prettyArg i) :| [prettyArg es] + ("constr" <+> prettyArg i) :| [prettyArg (toList es)] Case _ arg cs -> iterAppDocM $ \_ prettyArg -> "case" :| [prettyArg arg, prettyArg (toList cs)] instance diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs index 9815d9b29fe..7652ead3bdf 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Type.hs @@ -28,8 +28,11 @@ module UntypedPlutusCore.Core.Type import Control.Lens import PlutusPrelude +import Data.Hashable +import Data.Strict.List import Data.Vector import Data.Word +import GHC.IsList qualified as GHC import PlutusCore.Builtin qualified as TPLC import PlutusCore.Core qualified as TPLC import PlutusCore.MkPlc @@ -85,10 +88,13 @@ data Term name uni fun ann -- TODO: worry about overflow, maybe use an Integer -- TODO: try spine-strict list or strict list or vector -- See Note [Constr tag type] - | Constr !ann !Word64 ![Term name uni fun ann] + | Constr !ann !Word64 !(List (Term name uni fun ann)) | Case !ann !(Term name uni fun ann) !(Vector (Term name uni fun ann)) deriving stock (Functor, Generic) +deriving anyclass instance NFData a => NFData (List a) +deriving anyclass instance Hashable a => Hashable (List a) + deriving stock instance (Show name, GShow uni, Everywhere uni Show, Show fun, Show ann, Closed uni) => Show (Term name uni fun ann) @@ -123,7 +129,7 @@ instance TermLike (Term name uni fun) TPLC.TyName name uni fun where unwrap = const id iWrap = \_ _ _ -> id error = \ann _ -> Error ann - constr = \ann _ i es -> Constr ann i es + constr = \ann _ i es -> Constr ann i $ GHC.fromList es kase = \ann _ arg cs -> Case ann arg (fromList cs) instance TPLC.HasConstant (Term name uni fun ()) where diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Zip.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Zip.hs index 4d2ce01731c..e71a50e29a4 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Zip.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Zip.hs @@ -11,6 +11,7 @@ module UntypedPlutusCore.Core.Zip import Control.Monad (void, when) import Control.Monad.Except (MonadError, throwError) import Data.Vector +import GHC.IsList qualified as GHC import UntypedPlutusCore.Core.Instance.Eq () import UntypedPlutusCore.Core.Type @@ -60,7 +61,8 @@ tzipWith f term1 term2 = do go (Apply a1 t1a t1b) (Apply a2 t2a t2b) = Apply (f a1 a2) <$> go t1a t2a <*> go t1b t2b go (Force a1 t1) (Force a2 t2) = Force (f a1 a2) <$> go t1 t2 go (Delay a1 t1) (Delay a2 t2) = Delay (f a1 a2) <$> go t1 t2 - go (Constr a1 i1 ts1) (Constr a2 _i2 ts2) = Constr (f a1 a2) i1 <$> zipExactWithM go ts1 ts2 + go (Constr a1 i1 ts1) (Constr a2 _i2 ts2) = + Constr (f a1 a2) i1 <$> (GHC.fromList <$> zipExactWithM go (GHC.toList ts1) (GHC.toList ts2)) go (Case a1 t1 vs1) (Case a2 t2 vs2) = Case (f a1 a2) <$> go t1 t2 <*> (fromList <$> zipExactWithM go (toList vs1) (toList vs2)) go _ _ = diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs index 7964a31ec0e..120be55a01a 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs @@ -98,6 +98,7 @@ import Data.Hashable (Hashable) import Data.Kind qualified as GHC import Data.Proxy import Data.Semigroup (stimes) +import Data.Strict.List (List (..)) import Data.Text (Text) import Data.Vector qualified as V import Data.Word @@ -565,9 +566,9 @@ dischargeCekValue = \case VBuiltin _ term _ -> term VConstr i es -> Constr () i (fmap dischargeCekValue $ stack2list es) where - stack2list = go [] + stack2list = go Nil go acc EmptyStack = acc - go acc (ConsStack arg rest) = go (arg : acc) rest + go acc (ConsStack arg rest) = go (arg :! acc) rest instance (PrettyUni uni, Pretty fun) => PrettyBy PrettyConfigPlc (CekValue uni fun ann) where prettyBy cfg = prettyBy cfg . dischargeCekValue @@ -598,7 +599,7 @@ data Context uni fun ann | FrameForce !(Context uni fun ann) -- ^ @(force _)@ -- See Note [Accumulators for terms] - | FrameConstr !(CekValEnv uni fun ann) {-# UNPACK #-} !Word64 ![NTerm uni fun ann] !(ArgStack uni fun ann) !(Context uni fun ann) + | FrameConstr !(CekValEnv uni fun ann) {-# UNPACK #-} !Word64 !(List (NTerm uni fun ann)) !(ArgStack uni fun ann) !(Context uni fun ann) -- ^ @(constr i V0 ... Vj-1 _ Nj ... Nn)@ | FrameCases !(CekValEnv uni fun ann) !(V.Vector (NTerm uni fun ann)) !(Context uni fun ann) -- ^ @(case _ C0 .. Cn)@ @@ -727,8 +728,8 @@ enterComputeCek = computeCek computeCek !ctx !env (Constr _ i es) = do stepAndMaybeSpend BConstr case es of - (t : rest) -> computeCek (FrameConstr env i rest EmptyStack ctx) env t - [] -> returnCek ctx $ VConstr i EmptyStack + (t :! rest) -> computeCek (FrameConstr env i rest EmptyStack ctx) env t + Nil -> returnCek ctx $ VConstr i EmptyStack -- s ; ρ ▻ case S C0 ... Cn ↦ s , case _ (C0 ... Cn, ρ) ; ρ ▻ S computeCek !ctx !env (Case _ scrut cs) = do stepAndMaybeSpend BCase @@ -771,8 +772,8 @@ enterComputeCek = computeCek returnCek (FrameConstr env i todo done ctx) e = do let done' = ConsStack e done case todo of - (next : todo') -> computeCek (FrameConstr env i todo' done' ctx) env next - [] -> returnCek ctx $ VConstr i done' + (next :! todo') -> computeCek (FrameConstr env i todo' done' ctx) env next + Nil -> returnCek ctx $ VConstr i done' -- s , case _ (C0 ... CN, ρ) ◅ constr i V1 .. Vm ↦ s , [_ V1 ... Vm] ; ρ ▻ Ci returnCek (FrameCases env cs ctx) e = case e of -- If the index is larger than the max bound of an Int, or negative, then it's a bad index diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs index 0d795d334f3..40be83e062b 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs @@ -60,6 +60,7 @@ import Control.Monad.Primitive import Data.Proxy import Data.RandomAccessList.Class qualified as Env import Data.Semigroup (stimes) +import Data.Strict.List (List (..)) import Data.Text (Text) import Data.Vector qualified as V import Data.Word (Word64) @@ -99,7 +100,7 @@ data Context uni fun ann | FrameAwaitFunTerm ann !(CekValEnv uni fun ann) !(NTerm uni fun ann) !(Context uni fun ann) -- ^ @[_ N]@ | FrameAwaitFunValue ann !(CekValue uni fun ann) !(Context uni fun ann) | FrameForce ann !(Context uni fun ann) -- ^ @(force _)@ - | FrameConstr ann !(CekValEnv uni fun ann) {-# UNPACK #-} !Word64 ![NTerm uni fun ann] !(ArgStack uni fun ann) !(Context uni fun ann) + | FrameConstr ann !(CekValEnv uni fun ann) {-# UNPACK #-} !Word64 !(List (NTerm uni fun ann)) !(ArgStack uni fun ann) !(Context uni fun ann) | FrameCases ann !(CekValEnv uni fun ann) !(V.Vector (NTerm uni fun ann)) !(Context uni fun ann) | NoFrame @@ -158,8 +159,8 @@ computeCek !ctx !_ (Builtin _ bn) = do computeCek !ctx !env (Constr ann i es) = do stepAndMaybeSpend BConstr pure $ case es of - (t : rest) -> Computing (FrameConstr ann env i rest EmptyStack ctx) env t - [] -> Returning ctx $ VConstr i EmptyStack + (t :! rest) -> Computing (FrameConstr ann env i rest EmptyStack ctx) env t + Nil -> Returning ctx $ VConstr i EmptyStack -- s ; ρ ▻ case S C0 ... Cn ↦ s , case _ (C0 ... Cn, ρ) ; ρ ▻ S computeCek !ctx !env (Case ann scrut cs) = do stepAndMaybeSpend BCase @@ -196,8 +197,8 @@ returnCek (FrameAwaitFunValue ann arg ctx) fun = returnCek (FrameConstr ann env i todo done ctx) e = do let done' = ConsStack e done case todo of - (next : todo') -> computeCek (FrameConstr ann env i todo' done' ctx) env next - [] -> returnCek ctx $ VConstr i done' + (next :! todo') -> computeCek (FrameConstr ann env i todo' done' ctx) env next + Nil -> returnCek ctx $ VConstr i done' -- s , case _ (C0 ... CN, ρ) ◅ constr i V1 .. Vm ↦ s , [_ V1 ... Vm] ; ρ ▻ Ci returnCek (FrameCases ann env cs ctx) e = case e of -- If the index is larger than the max bound of an Int, or negative, then it's a bad index diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs index 91fb56d29a2..599e83ce9fe 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Parser.hs @@ -29,6 +29,7 @@ import UntypedPlutusCore.Rename (Rename (rename)) import Data.Text (Text) import Data.Vector qualified as V +import GHC.IsList qualified as GHC import PlutusCore.Error (AsParserErrorBundle) import PlutusCore.MkPlc (mkIterApp) import PlutusCore.Parser hiding (parseProgram, parseTerm, program) @@ -75,7 +76,9 @@ errorTerm = withSpan $ \sp -> constrTerm :: Parser PTerm constrTerm = withSpan $ \sp -> inParens $ do - res <- UPLC.Constr sp <$> (symbol "constr" *> lexeme Lex.decimal) <*> many term + res <- UPLC.Constr sp + <$> (symbol "constr" *> lexeme Lex.decimal) + <*> (GHC.fromList <$> many term) whenVersion (\v -> v < plcVersion110) $ fail "'constr' is not allowed before version 1.1.0" pure res diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs index d17a44236ae..5a850217ef4 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/CaseReduce.hs @@ -11,6 +11,7 @@ import UntypedPlutusCore.Transform.Simplifier (SimplifierStage (CaseReduce), Sim import Control.Lens (transformOf) import Data.Vector qualified as V +import GHC.IsList qualified as GHC caseReduce :: Monad m @@ -24,5 +25,5 @@ caseReduce term = do processTerm :: Term name uni fun a -> Term name uni fun a processTerm = \case Case ann (Constr _ i args) cs | Just c <- (V.!?) cs (fromIntegral i) -> - mkIterApp c ((ann,) <$> args) + mkIterApp c ((ann,) <$> GHC.toList args) t -> t diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs index 054b6c71820..5053d95df8e 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Transform/Inline.hs @@ -410,7 +410,7 @@ costIsAcceptable = \case Apply{} -> False -- Inlining constructors of size 1 or 0 seems okay, but does result in doing -- the work for the elements at each use site. - Constr _ _ es -> case es of + Constr _ _ es -> case toList es of [] -> True [e] -> costIsAcceptable e _ -> False @@ -434,7 +434,7 @@ sizeIsAcceptable inlineConstants = \case -- See Note [Differences from PIR inliner] 4 LamAbs{} -> False -- Inlining constructors of size 1 or 0 seems okay - Constr _ _ es -> case es of + Constr _ _ es -> case toList es of [] -> True [e] -> sizeIsAcceptable inlineConstants e _ -> False diff --git a/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs b/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs index 9973f8b95ca..eb3af15c7ce 100644 --- a/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs +++ b/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} module Analysis.Spec where @@ -20,15 +22,15 @@ goldenEvalOrder name tm = -- Should hit Unknown before trying to process the undefined. Shows -- that the computation is lazy --- [ [ n m ] (constr 1 [undefined]) ] +-- [ [ n m ] [undefined] ] dangerTerm :: Term Name PLC.DefaultUni PLC.DefaultFun () dangerTerm = runQuote $ do n <- freshName "n" m <- freshName "m" -- The UPLC term type is strict, so it's hard to hide an undefined in there - -- Take advantage of the fact that it's still using lazy lists for constr + -- Take advantage of the fact that it's still using lazy lists as constant -- arguments for now. - pure $ Apply () (Apply () (Var () n) (Var () m)) (Constr () 1 [undefined]) + pure $ Apply () (Apply () (Var () n) (Var () m)) (mkConstant @[Integer] () [undefined]) letFun :: Term Name PLC.DefaultUni PLC.DefaultFun () letFun = runQuote $ do diff --git a/plutus-core/untyped-plutus-core/test/Generators.hs b/plutus-core/untyped-plutus-core/test/Generators.hs index 791ab327c4c..d4ddf29a23a 100644 --- a/plutus-core/untyped-plutus-core/test/Generators.hs +++ b/plutus-core/untyped-plutus-core/test/Generators.hs @@ -29,6 +29,7 @@ import Control.Lens (view) import Data.Text (Text) import Data.Text qualified as T import Data.Vector qualified as V +import GHC.IsList qualified as GHC import Hedgehog (annotate, annotateShow, failure, property, tripping, (===)) import Hedgehog.Gen qualified as Gen @@ -60,7 +61,7 @@ compareTerm (Force _ t ) (Force _ t') = compareTerm t t' compareTerm (Delay _ t ) (Delay _ t') = compareTerm t t' compareTerm (Constant _ x) (Constant _ y) = x == y compareTerm (Builtin _ bi) (Builtin _ bi') = bi == bi' -compareTerm (Constr _ i es) (Constr _ i' es') = i == i' && maybe False (all (uncurry compareTerm)) (zipExact es es') +compareTerm (Constr _ i es) (Constr _ i' es') = i == i' && maybe False (all (uncurry compareTerm)) (zipExact (GHC.toList es) (GHC.toList es')) compareTerm (Case _ arg cs) (Case _ arg' cs') = compareTerm arg arg' && maybe False (all (uncurry compareTerm)) (zipExact (V.toList cs) (V.toList cs')) compareTerm (Error _ ) (Error _ ) = True compareTerm _ _ = False diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/Test.hs b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/Test.hs index f942dd431f7..b9a4928d036 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/Test.hs +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/Test.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} diff --git a/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs b/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs index e5b2e770e10..2f66f9905ab 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs +++ b/plutus-core/untyped-plutus-core/test/Transform/Simplify.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} @@ -449,7 +450,7 @@ cseExpensive = plus arg arg' where plus a b = mkIterApp (Builtin () PLC.AddInteger) [((), a), ((), b)] con = mkConstant @Integer () - mkArg = foldl1 plus . fmap (\i -> plus (con (2 * i)) (con (2 * i + 1))) + mkArg = foldl1 plus . map (\i -> plus (con (2 * i)) (con (2 * i + 1))) arg = mkArg [0 .. 200] arg' = mkArg [0 .. 200] diff --git a/plutus-metatheory/src/Untyped.hs b/plutus-metatheory/src/Untyped.hs index 4a41318cc6b..af3bc5661e6 100644 --- a/plutus-metatheory/src/Untyped.hs +++ b/plutus-metatheory/src/Untyped.hs @@ -11,6 +11,7 @@ import Data.ByteString as BS hiding (map) import Data.Text as T hiding (map) import Data.Word (Word64) import GHC.Exts (IsList (..)) +import GHC.IsList qualified as GHC import Universe -- Untyped (Raw) syntax @@ -42,7 +43,7 @@ conv (Constant _ c) = UCon c conv (Error _) = UError conv (Delay _ t) = UDelay (conv t) conv (Force _ t) = UForce (conv t) -conv (Constr _ i es) = UConstr (toInteger i) (toList (fmap conv es)) +conv (Constr _ i es) = UConstr (toInteger i) (map conv $ GHC.toList es) conv (Case _ arg cs) = UCase (conv arg) (toList (fmap conv cs)) tmnames = ['a' .. 'z'] @@ -63,6 +64,6 @@ uconv i UError = Error () uconv i (UBuiltin b) = Builtin () b uconv i (UDelay t) = Delay () (uconv i t) uconv i (UForce t) = Force () (uconv i t) -uconv i (UConstr j xs) = Constr () (fromInteger j) (fmap (uconv i) xs) +uconv i (UConstr j xs) = Constr () (fromInteger j) (GHC.fromList $ map (uconv i) xs) uconv i (UCase t xs) = Case () (uconv i t) (fromList (fmap (uconv i) xs))