merge

.gitignore

@@ -1,3 +1,4 @@
 /result*
 /dist-newstyle
 .direnv
+bench.csv

Plutarch.hs

@@ -22,9 +22,8 @@ module Plutarch (
   PI.punsafeConstant,
   PI.Term,
   PI.TermCont (..),
-  PL.plift,
-  PL.pconstant,
-  PL.plift',
+  PI.S,
+  PI.PType,
   PlutusType (..),
   printTerm,
   printScript,
@@ -40,13 +39,10 @@ module Plutarch (
   popaque,
   punsafeFromOpaque,
   plam,
-  -- $plam
 ) where
 
-import Data.Kind (Type)
-import Plutarch.Internal (ClosedTerm, Term, compile, papp, phoistAcyclic, plam', punsafeCoerce, (:-->))
+import Plutarch.Internal (ClosedTerm, PType, Term, compile, papp, phoistAcyclic, plam', punsafeCoerce, (:-->))
 import qualified Plutarch.Internal as PI
-import qualified Plutarch.Lift as PL
 import Plutus.V1.Ledger.Scripts (Script (Script))
 import PlutusCore.Pretty (prettyPlcReadableDebug)
 
@@ -139,7 +135,7 @@ pinl v f = f v
 
   A simple example, encoding a Sum type as an Enum via PInteger:
 
-  > data AB (s :: k) = A | B
+  > data AB (s :: S) = A | B
   >
   > instance PlutusType AB where
   >   type PInner AB _ = PInteger
@@ -161,10 +157,10 @@ pinl v f = f v
 
   Further examples can be found in examples/PlutusType.hs
 -}
-class (PCon a, PMatch a) => PlutusType (a :: k -> Type) where
+class (PCon a, PMatch a) => PlutusType (a :: PType) where
   -- `b' :: k'` causes GHC to fail type checking at various places
   -- due to not being able to expand the type family.
-  type PInner a (b' :: k -> Type) :: k -> Type
+  type PInner a (b' :: PType) :: PType
   pcon' :: forall s. a s -> forall b. Term s (PInner a b)
   pmatch' :: forall s c. (forall b. Term s (PInner a b)) -> (a s -> Term s c) -> Term s c
 

Plutarch/Api/V1.hs

@@ -86,7 +86,7 @@ type PTuple = PDataList
 
 ---------- V1 Specific types, Incompatible with V2
 
-newtype PTxInfo (s :: k)
+newtype PTxInfo (s :: S)
   = PTxInfo
       ( Term
           s
@@ -126,7 +126,7 @@ instance PIsDataRepr PTxInfo where
   pmatchRepr dat f =
     (pmatchDataRepr dat) ((DRHCons (f . PTxInfo)) $ DRHNil)
 
-newtype PScriptContext (s :: k)
+newtype PScriptContext (s :: S)
   = PScriptContext (Term s (PDataList '[PTxInfo, PScriptPurpose]))
   deriving
     (PMatch, PIsData, PUnsafeLiftDecl Plutus.ScriptContext)
@@ -144,7 +144,7 @@ instance PIsDataRepr PScriptContext where
 
 -- General types, used by V1 and V2
 
-data PScriptPurpose (s :: k)
+data PScriptPurpose (s :: S)
   = PMinting (Term s (PDataList '[PCurrencySymbol]))
   | PSpending (Term s (PDataList '[PTxOutRef]))
   | PRewarding (Term s (PDataList '[PStakingCredential]))
@@ -173,60 +173,60 @@ instance PIsDataRepr PScriptPurpose where
 
 ---------- Scripts
 
-newtype PDatum (s :: k) = PDatum (Term s PData)
+newtype PDatum (s :: S) = PDatum (Term s PData)
   deriving (PIsData, PEq) via PData
 
-newtype PRedeemer (s :: k) = PRedeemer (Term s PData)
+newtype PRedeemer (s :: S) = PRedeemer (Term s PData)
   deriving (PIsData, PEq) via PData
 
-newtype PDatumHash (s :: k)
+newtype PDatumHash (s :: S)
   = PDatumHash (Term s PByteString)
   deriving (PEq, POrd, PIsData) via PByteString
 
-newtype PStakeValidatorHash (s :: k)
+newtype PStakeValidatorHash (s :: S)
   = PStakeValidatorHash (Term s PByteString)
   deriving (PEq, POrd, PIsData) via PByteString
 
-newtype PRedeemerHash (s :: k)
+newtype PRedeemerHash (s :: S)
   = PRedeemerHash (Term s PByteString)
   deriving (PEq, POrd, PIsData) via PByteString
 
-newtype PValidatorHash (s :: k)
+newtype PValidatorHash (s :: S)
   = PValidatorHash (Term s PByteString)
   deriving (PEq, POrd, PIsData) via PByteString
 
 ---------- Value
 
-newtype PTokenName (s :: k)
+newtype PTokenName (s :: S)
   = PTokenName (Term s PByteString)
   deriving (PEq, POrd, PIsData) via (PByteString)
   deriving newtype (Semigroup, Monoid)
 
-newtype PValue (s :: k)
+newtype PValue (s :: S)
   = PValue (Term s (PMap PCurrencySymbol (PMap PTokenName PInteger)))
   deriving (PIsData) via (PMap PCurrencySymbol (PMap PTokenName PInteger))
 
-newtype PCurrencySymbol (s :: k)
+newtype PCurrencySymbol (s :: S)
   = PCurrencySymbol (Term s PByteString)
   deriving (PEq, POrd, PIsData) via PByteString
 
 ---------- Crypto
 
-newtype PPubKeyHash (s :: k)
+newtype PPubKeyHash (s :: S)
   = PPubKeyHash (Term s PByteString)
   deriving (PEq, POrd, PIsData) via PByteString
 
-newtype PPubKey (s :: k)
+newtype PPubKey (s :: S)
   = PPubKey (Term s PByteString)
   deriving (PEq, POrd, PIsData) via PByteString
 
-newtype PSignature (s :: k)
+newtype PSignature (s :: S)
   = PSignature (Term s PByteString)
   deriving (PEq, POrd, PIsData) via PByteString
 
 ---------- Time
 
-newtype PPOSIXTime (s :: k)
+newtype PPOSIXTime (s :: S)
   = PPOSIXTime (Term s PInteger)
   deriving (POrd, PEq, PIntegral, PIsData) via (PInteger)
   deriving newtype (Num)
@@ -237,7 +237,7 @@ type PPOSIXTimeRange = PInterval PPOSIXTime
 
 type PClosure = PBool
 
-newtype PInterval a (s :: k)
+newtype PInterval a (s :: S)
   = PInterval
       ( Term
           s
@@ -267,7 +267,7 @@ instance PIsDataRepr (PInterval a) where
     pmatchDataRepr dat $
       DRHCons (f . PInterval) DRHNil
 
-newtype PLowerBound a (s :: k)
+newtype PLowerBound a (s :: S)
   = PLowerBound (Term s (PDataList '[PExtended a, PClosure]))
   deriving
     ( PMatch
@@ -290,7 +290,7 @@ instance PIsDataRepr (PLowerBound a) where
     pmatchDataRepr dat $
       DRHCons (f . PLowerBound) DRHNil
 
-newtype PUpperBound a (s :: k)
+newtype PUpperBound a (s :: S)
   = PUpperBound (Term s (PDataList '[PExtended a, PClosure]))
   deriving
     ( PMatch
@@ -312,7 +312,7 @@ instance PIsDataRepr (PUpperBound a) where
     pmatchDataRepr dat $
       DRHCons (f . PUpperBound) DRHNil
 
-data PExtended a (s :: k)
+data PExtended a (s :: S)
   = PNegInf (Term s (PDataList '[]))
   | PFinite (Term s (PDataList '[a]))
   | PPosInf (Term s (PDataList '[]))
@@ -335,7 +335,7 @@ instance PIsDataRepr (PExtended a) where
 
 ---------- Tx/Address
 
-data PCredential (s :: k)
+data PCredential (s :: S)
   = PPubKeyCredential (Term s (PDataList '[PPubKeyHash]))
   | PScriptCredential (Term s (PDataList '[PValidatorHash]))
   deriving
@@ -356,7 +356,7 @@ instance PIsDataRepr PCredential where
           (f . PScriptCredential)
           DRHNil
 
-data PStakingCredential (s :: k)
+data PStakingCredential (s :: S)
   = PStakingHash (Term s (PDataList '[PCredential]))
   | PStakingPtr (Term s (PDataList '[PInteger, PInteger, PInteger]))
   deriving
@@ -377,7 +377,7 @@ instance PIsDataRepr PStakingCredential where
       DRHCons (f . PStakingHash) $
         DRHCons (f . PStakingPtr) DRHNil
 
-newtype PAddress (s :: k)
+newtype PAddress (s :: S)
   = PAddress
       ( Term
           s
@@ -405,7 +405,7 @@ instance PIsDataRepr PAddress where
 
 ---------- Tx
 
-newtype PTxId (s :: k)
+newtype PTxId (s :: S)
   = PTxId (Term s (PDataList '[PByteString]))
   deriving
     (PMatch, PIsData, PUnsafeLiftDecl Plutus.TxId)
@@ -418,7 +418,7 @@ instance PIsDataRepr PTxId where
     pmatchDataRepr dat $
       DRHCons (f . PTxId) DRHNil
 
-newtype PTxOutRef (s :: k)
+newtype PTxOutRef (s :: S)
   = PTxOutRef (Term s (PDataList '[PTxId, PInteger]))
   deriving
     (PMatch, PIsData, PUnsafeLiftDecl Plutus.TxOutRef)
@@ -431,7 +431,7 @@ instance PIsDataRepr PTxOutRef where
     pmatchDataRepr dat $
       DRHCons (f . PTxOutRef) DRHNil
 
-newtype PTxInInfo (s :: k)
+newtype PTxInInfo (s :: S)
   = PTxInInfo (Term s (PDataList '[PTxOutRef, PTxOut]))
   deriving
     (PMatch, PIsData, PUnsafeLiftDecl Plutus.TxInfo)
@@ -444,7 +444,7 @@ instance PIsDataRepr PTxInInfo where
     pmatchDataRepr dat $
       DRHCons (f . PTxInInfo) DRHNil
 
-newtype PTxOut (s :: k)
+newtype PTxOut (s :: S)
   = PTxOut
       ( Term
           s
@@ -472,7 +472,7 @@ instance PIsDataRepr PTxOut where
     pmatchDataRepr dat $
       DRHCons (f . PTxOut) DRHNil
 
-data PDCert (s :: k)
+data PDCert (s :: S)
   = PDCertDelegRegKey (Term s (PDataList '[PStakingCredential]))
   | PDCertDelegDeRegKey (Term s (PDataList '[PStakingCredential]))
   | PDCertDelegDelegate (Term s (PDataList '[PStakingCredential, PPubKeyHash]))
@@ -508,13 +508,13 @@ instance PIsDataRepr PDCert where
 
 ---------- AssocMap
 
-newtype PMap (a :: k -> Type) (b :: k -> Type) (s :: k)
+newtype PMap (a :: PType) (b :: PType) (s :: S)
   = PMap (Term s (PBuiltinMap a b))
   deriving (PIsData) via (PBuiltinMap a b)
 
 ---------- Others
 
-data PMaybe a (s :: k)
+data PMaybe a (s :: S)
   = PNothing (Term s (PDataList '[]))
   | PJust (Term s (PDataList '[a]))
   deriving
@@ -531,7 +531,7 @@ instance PIsDataRepr (PMaybe a) where
       DRHCons (f . PNothing) $
         DRHCons (f . PJust) DRHNil
 
-data PEither a b (s :: k)
+data PEither a b (s :: S)
   = PLeft (Term s (PDataList '[a]))
   | PRight (Term s (PDataList '[b]))
   deriving

Plutarch/Builtin.hs

@@ -23,7 +23,7 @@ module Plutarch.Builtin (
 ) where
 
 import Plutarch (PlutusType (..), punsafeBuiltin, punsafeCoerce)
-import Plutarch.Bool (PBool (..), PEq, (#==))
+import Plutarch.Bool (PBool (..), PEq, pif', (#==))
 import Plutarch.ByteString (PByteString)
 import Plutarch.Integer (PInteger)
 import Plutarch.Lift (DerivePLiftViaCoercible, PLift, PLifted, PLiftedRepr, PUnsafeLiftDecl, pconstant, pliftFromRepr, pliftToRepr)
@@ -33,16 +33,16 @@ import qualified PlutusCore as PLC
 import PlutusTx (Data)
 
 -- | Plutus 'BuiltinPair'
-data PBuiltinPair (a :: k -> Type) (b :: k -> Type) (s :: k)
+data PBuiltinPair (a :: PType) (b :: PType) (s :: S)
 
 -- FIXME: figure out good way of deriving this
 instance (PUnsafeLiftDecl ah a, PUnsafeLiftDecl bh b) => PUnsafeLiftDecl (ah, bh) (PBuiltinPair a b) where
   type PLiftedRepr (PBuiltinPair a b) = (PLiftedRepr a, PLiftedRepr b)
   type PLifted (PBuiltinPair a b) = (PLifted a, PLifted b)
-  pliftToRepr (x, y) = (pliftToRepr @_ @_ @a x, pliftToRepr @_ @_ @b y)
+  pliftToRepr (x, y) = (pliftToRepr @_ @a x, pliftToRepr @_ @b y)
   pliftFromRepr (x, y) = do
-    x' <- pliftFromRepr @_ @_ @a x
-    y' <- pliftFromRepr @_ @_ @b y
+    x' <- pliftFromRepr @_ @a x
+    y' <- pliftFromRepr @_ @b y
     Just (x', y')
 
 pfstBuiltin :: Term s (PBuiltinPair a b :--> a)
@@ -59,7 +59,7 @@ ppairDataBuiltin :: Term s (PAsData a :--> PAsData b :--> PBuiltinPair (PAsData
 ppairDataBuiltin = punsafeBuiltin PLC.MkPairData
 
 -- | Plutus 'BuiltinList'
-data PBuiltinList (a :: k -> Type) (s :: k)
+data PBuiltinList (a :: PType) (s :: S)
   = PCons (Term s a) (Term s (PBuiltinList a))
   | PNil
 
@@ -81,8 +81,8 @@ pconsBuiltin = phoistAcyclic $ pforce $ punsafeBuiltin PLC.MkCons
 instance PUnsafeLiftDecl ah a => PUnsafeLiftDecl [ah] (PBuiltinList a) where
   type PLifted (PBuiltinList a) = [PLifted a]
   type PLiftedRepr (PBuiltinList a) = [PLiftedRepr a]
-  pliftToRepr x = pliftToRepr @_ @_ @a <$> x
-  pliftFromRepr x = traverse (pliftFromRepr @_ @_ @a) x
+  pliftToRepr x = pliftToRepr @_ @a <$> x
+  pliftFromRepr x = traverse (pliftFromRepr @_ @a) x
 
 instance PLift a => PlutusType (PBuiltinList a) where
   type PInner (PBuiltinList a) _ = PBuiltinList a
@@ -150,7 +150,15 @@ pasByteStr = punsafeBuiltin PLC.UnBData
 pdataLiteral :: Data -> Term s PData
 pdataLiteral = pconstant
 
-data PAsData (a :: k -> Type) (s :: k)
+data PAsData (a :: PType) (s :: S)
+
+data PAsDataLifted (a :: PType)
+
+instance PUnsafeLiftDecl (PAsDataLifted a) (PAsData a) where
+  type PLifted (PAsData a) = PAsDataLifted a
+  type PLiftedRepr (PAsData a) = Data
+  pliftToRepr = \case
+  pliftFromRepr _ = Nothing
 
 pforgetData :: Term s (PAsData a) -> Term s PData
 pforgetData = punsafeCoerce
@@ -184,6 +192,30 @@ instance PIsData PByteString where
   pfromData x = pasByteStr # pforgetData x
   pdata x = punsafeBuiltin PLC.BData # x
 
+{- |
+  Instance for PBool following the Plutus IsData repr
+  given by @makeIsDataIndexed ''Bool [('False,0),('True,1)]@,
+  which is used in 'TxInfo' via 'Closure'.
+-}
+instance PIsData PBool where
+  pfromData x =
+    (phoistAcyclic $ plam toBool) # pforgetData x
+    where
+      toBool :: Term s PData -> Term s PBool
+      toBool d = pfstBuiltin # (pasConstr # d) #== 1
+
+  pdata x =
+    (phoistAcyclic $ plam toData) # x
+    where
+      toData :: Term s PBool -> Term s (PAsData PBool)
+      toData b =
+        punsafeBuiltin PLC.ConstrData
+          # (pif' # b # 1 # (0 :: Term s PInteger))
+          # nil
+
+      nil :: Term s (PBuiltinList PData)
+      nil = pnil
+
 instance PIsData (PBuiltinPair PInteger (PBuiltinList PData)) where
   pfromData x = pasConstr # pforgetData x
   pdata x' = plet x' $ \x -> punsafeBuiltin PLC.ConstrData # (pfstBuiltin # x) #$ psndBuiltin # x