Skip to content

Commit 675265d

Browse files
bladyjokerbladyjoker
committed
Prelude opaques get PlutusData, let's see
1 parent a18f31d commit 675265d

File tree

6 files changed

+90
-28
lines changed

6 files changed

+90
-28
lines changed

‎lambda-buffers-codegen/src/LambdaBuffers/Codegen/Haskell/Print.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -117,7 +117,7 @@ printHsQClassImpl env mn iTyDefs hqcn d =
117117

118118
printLanguageExtensions :: Pretty a => [a] -> Doc ann
119119
printLanguageExtensions [] = mempty
120-
printLanguageExtensions exts = "{-# LANGUAGE" <+> encloseSep mempty mempty comma (pretty <$> exts) <+> "#-}"
120+
printLanguageExtensions exts = "{-# LANGUAGE" <+> align (encloseSep mempty mempty comma (pretty <$> exts)) <+> "#-}"
121121

122122
printModuleHeader :: PrintModuleEnv m ann -> PC.ModuleName -> Set (PC.InfoLess PC.TyName) -> Doc ann
123123
printModuleHeader env mn exports = "module" <+> env'printModuleName env mn <+> printExports exports <+> "where"

‎lambda-buffers-codegen/src/LambdaBuffers/Codegen/Plutarch/Print/TyDef.hs

Lines changed: 24 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,26 +36,49 @@ translates to
3636
```haskell
3737
data FooSum (a :: Plutarch.PType) (b :: Plutarch.PType) (s :: Plutarch.S) = FooSum'Foo (Plutarch.Term s (Plutarch.Builtin.PAsData (PMaybe a))) | FooSum'Bar (Plutarch.Term s (Plutarch.Builtin.PAsData b))
3838
..........................................................................................................................................................................................................
39+
deriving stock GHC.Generics.Generic
40+
...................................
41+
deriving anyclass Plutarch.Show.PShow
42+
.....................................
3943
data FooProd (a :: Plutarch.PType) (b :: Plutarch.PType) (s :: Plutarch.S) = FooProd (Plutarch.Term s (Plutarch.Builtin.PAsData (PMaybe a))) (Plutarch.Term s (Plutarch.Builtin.PAsData b))
4044
...........................................................................................................................................................................................
45+
deriving stock GHC.Generics.Generic
46+
...................................
47+
deriving anyclass Plutarch.Show.PShow
48+
.....................................
4149
data FooRecord (a :: Plutarch.PType) (b :: Plutarch.PType) (s :: Plutarch.S) = FooRecord (Plutarch.Term s (Plutarch.Builtin.PAsData (PMaybe a))) (Plutarch.Term s (Plutarch.Builtin.PAsData b))
4250
...............................................................................................................................................................................................
51+
deriving stock GHC.Generics.Generic
52+
...................................
53+
deriving anyclass Plutarch.Show.PShow
54+
.....................................
4355
type FooOpaque = Some.Configured.Opaque.FooOpaque
4456
.................................................
4557
newtype FooProdUnit (a :: Plutarch.PType) (s :: Plutarch.S) = FooProdUnit (Plutarch.Term s (Plutarch.Builtin.PAsData (PMaybe a)))
4658
.................................................................................................................................
59+
deriving stock GHC.Generics.Generic
60+
...................................
61+
deriving anyclass Plutarch.Show.PShow
62+
.....................................
4763
newtype FooRecUnit (a :: Plutarch.PType) (s :: Plutarch.S) = FooRecUnit (Plutarch.Term s (Plutarch.Builtin.PAsData (PMaybe a)))
4864
...............................................................................................................................
65+
deriving stock GHC.Generics.Generic
66+
...................................
67+
deriving anyclass Plutarch.Show.PShow
68+
.....................................
4969
```
5070
5171
And signals the following imports:
5272
5373
```haskell
5474
import qualified Plutarch
75+
import qualified Plutarch.Builtin
76+
import qualified Plutarch.Show
77+
import qualified GHC.Generics
5578
import qualified Some.Configured.Opaque
5679
```
5780
58-
NOTE(bladyjoker): The full qualification is omitted in the following docstrings for brevity.
81+
NOTE(bladyjoker): The full qualification is omitted in the following docstrings for brevity, as are deriving statements.
5982
-}
6083
printTyDef :: MonadPrint m => PC.TyDef -> m (Doc ann)
6184
printTyDef (PC.TyDef tyN tyabs _) = do

‎libs/lbf-plutus/Plutus/V1.lbf

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,10 @@
11
module Plutus.V1
22

3-
import Prelude (Eq, Json, Integer, Bool)
3+
import Prelude (Eq, Json, Integer, Bool, Maybe, Either, List)
44

55
-- PlutusData encoding
66
class PlutusData a
77

8-
-- TODO(bladyjoker): PlutusTx has an Eq class: class Eq a
9-
108
-- PlutusTx.Builtins
119
opaque PlutusData
1210

@@ -18,6 +16,9 @@ instance Json PlutusData
1816
-- TODO(bladyjoker): Add other Prelude types (Maybe, Either, Text, Bytes etc.)
1917
instance PlutusData Bool
2018
instance PlutusData Integer
19+
instance PlutusData (Maybe a) :- PlutusData a
20+
instance PlutusData (List a) :- PlutusData a
21+
instance PlutusData (Either a b) :- PlutusData a, PlutusData b
2122

2223
-- PlutusLedgerApi.V1.Address
2324

‎runtimes/haskell/lbr-plutarch/src/LambdaBuffers/Runtime/Plutarch.hs

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@
66
module LambdaBuffers.Runtime.Plutarch (PEither (..), PAssetClass, PMap, PChar, PSet, PValue, ptryFromPAsData, PMaybe (..), pcon) where
77

88
import Data.Functor.Const (Const)
9+
import GHC.Generics (Generic)
910
import GHC.TypeLits qualified as GHC
1011
import LambdaBuffers.Runtime.Plutarch.LamVal qualified as LamVal
1112
import Plutarch (
@@ -56,21 +57,27 @@ data PChar (s :: S) = PChar
5657
data PEither (a :: PType) (b :: PType) (s :: S)
5758
= PLeft (Term s (PAsData a))
5859
| PRight (Term s (PAsData b))
60+
deriving stock (Generic)
61+
deriving anyclass (Pl.PShow)
5962

6063
-- | PMaybe messed up in Plutarch so redefining here.
6164
data PMaybe (a :: PType) (s :: S)
6265
= PJust (Term s (PAsData a))
6366
| PNothing
67+
deriving stock (Generic)
68+
deriving anyclass (Pl.PShow)
6469

6570
data PFoo (a :: PType) (s :: S)
6671
= PFoo
67-
(Term s (PAsData PInteger))
68-
(Term s (PAsData PBool))
72+
(Term s (PAsData (PMaybe PInteger)))
73+
(Term s (PAsData (PEither PBool PBool)))
6974
(Term s (PAsData PByteString))
7075
(Term s (PAsData (PMaybe a)))
7176
(Term s (PAsData (PEither a a)))
7277
(Term s (PAsData PAssetClass))
7378
(Term s (PAsData (PFoo a)))
79+
deriving stock (Generic)
80+
deriving anyclass (Pl.PShow)
7481

7582
-- PlutusType instances
7683
-- Encodings: https://github.com/input-output-hk/plutus/blob/650a0659cbaacec2166e0153d2393c779cedc4c0/plutus-tx/src/PlutusTx/IsData/Instances.hs

‎runtimes/haskell/lbr-plutarch/src/LambdaBuffers/Runtime/Plutarch/LamVal.hs

Lines changed: 18 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -17,11 +17,13 @@ module LambdaBuffers.Runtime.Plutarch.LamVal (
1717
) where
1818

1919
import Plutarch (
20+
ClosedTerm,
2021
Term,
2122
pcon,
2223
pdelay,
2324
perror,
2425
pforce,
26+
phoistAcyclic,
2527
plam,
2628
plet,
2729
(#),
@@ -44,43 +46,43 @@ import Plutarch.Prelude (PAsData, PBuiltinList (PCons), PInteger, PTryFrom, ptra
4446
import Plutarch.Unsafe (punsafeCoerce)
4547

4648
-- | Plutarch `toPlutusData :: a -> PlutusData`
47-
ptoPlutusData :: Term s (PAsData a :--> PData)
49+
ptoPlutusData :: ClosedTerm (PAsData a :--> PData)
4850
ptoPlutusData = plam toPlutusData
4951

5052
-- | Haskell `toPlutusData :: a -> PlutusData`
5153
toPlutusData :: Term s (PAsData a) -> Term s PData
5254
toPlutusData = pforgetData
5355

5456
-- | Plutarch PlutusType `fromPlutusData :: PlutusData -> Parser a`
55-
pfromPlutusDataPlutusType :: Term s (PData :--> PAsData a)
57+
pfromPlutusDataPlutusType :: ClosedTerm (PData :--> PAsData a)
5658
pfromPlutusDataPlutusType = plam punsafeCoerce
5759

5860
-- | Plutarch PTryFrom `fromPlutusData :: PlutusData -> Parser a`
59-
pfromPlutusDataPTryFrom :: (PTryFrom PData (PAsData a)) => Term s (PData :--> PAsData a)
60-
pfromPlutusDataPTryFrom = plam ptryFromData
61+
pfromPlutusDataPTryFrom :: (PTryFrom PData (PAsData a)) => ClosedTerm (PData :--> PAsData a)
62+
pfromPlutusDataPTryFrom = phoistAcyclic $ plam ptryFromData
6163
where
6264
ptryFromData :: forall a s. PTryFrom PData (PAsData a) => Term s PData -> Term s (PAsData a)
6365
ptryFromData pd = ptryFrom @(PAsData a) pd fst
6466

6567
-- | Plutarch `constrData :: IntE -> ListE PlutusData -> PlutusData`
66-
pconstrData :: Term s (PInteger :--> PBuiltinList PData :--> PData)
67-
pconstrData = plam $ \ix args -> pforgetData $ pconstrBuiltin # ix # args
68+
pconstrData :: ClosedTerm (PInteger :--> PBuiltinList PData :--> PData)
69+
pconstrData = phoistAcyclic $ plam $ \ix args -> pforgetData $ pconstrBuiltin # ix # args
6870

6971
-- | Haskell `constrData :: IntE -> ListE PlutusData -> PlutusData`
7072
constrData :: Term s PInteger -> [Term s PData] -> Term s PData
7173
constrData ix args = pforgetData $ pconstrBuiltin # ix # toBuiltinList args
7274

7375
-- | Plutarch `integerData :: IntE -> PlutusData`
74-
pintegerData :: Term s (PInteger :--> PData)
75-
pintegerData = plam $ \i -> ptoPlutusData # pdata i
76+
pintegerData :: ClosedTerm (PInteger :--> PData)
77+
pintegerData = phoistAcyclic $ plam $ \i -> ptoPlutusData # pdata i
7678

7779
-- | Haskell `integerData :: IntE -> PlutusData`
7880
integerData :: Term s PInteger -> Term s PData
7981
integerData = toPlutusData . pdata
8082

8183
-- | Plutarch `listData :: ListE PlutusData -> PlutusData`
82-
plistData :: Term s (PBuiltinList PData :--> PData)
83-
plistData = plam $ pforgetData . pdata
84+
plistData :: ClosedTerm (PBuiltinList PData :--> PData)
85+
plistData = phoistAcyclic $ plam $ pforgetData . pdata
8486

8587
-- | Haskell `listData :: ListE PlutusData -> PlutusData`
8688
listData :: [Term s PData] -> Term s PData
@@ -92,8 +94,8 @@ toBuiltinList (x : xs) = pcon (PCons x (toBuiltinList xs))
9294

9395
-- | Plutarch `casePlutusData :: (Int -> [PlutusData] -> a) -> ([PlutusData] -> a) -> (Int -> a) -> (PlutusData -> a) -> PlutusData -> a`
9496
pcasePlutusData ::
95-
Term s ((PInteger :--> PBuiltinList PData :--> a) :--> (PBuiltinList PData :--> a) :--> (PInteger :--> a) :--> (PData :--> a) :--> PData :--> a)
96-
pcasePlutusData = plam $ \handleConstr handleList handleInt handleOther pd ->
97+
ClosedTerm ((PInteger :--> PBuiltinList PData :--> a) :--> (PBuiltinList PData :--> a) :--> (PInteger :--> a) :--> (PData :--> a) :--> PData :--> a)
98+
pcasePlutusData = phoistAcyclic $ plam $ \handleConstr handleList handleInt handleOther pd ->
9799
pforce $
98100
pchooseData
99101
# pd
@@ -114,13 +116,13 @@ casePlutusData ::
114116
casePlutusData handleConstr handleList handleInt handleOther pd = pcasePlutusData # plam handleConstr # plam handleList # plam handleInt # plam handleOther # pd
115117

116118
-- | Plutarch `succeedParse :: a -> Parser a`
117-
psucceedParse :: Term s (a :--> a)
119+
psucceedParse :: ClosedTerm (a :--> a)
118120
psucceedParse = plam id
119121

120122
-- | Plutarch `failParse :: Parser a`
121-
pfailParse :: Term s a
123+
pfailParse :: ClosedTerm a
122124
pfailParse = perror
123125

124126
-- | Plutarch `bindParse :: Parser a -> (a -> Parser b) -> Parser b`
125-
pbindParse :: Term s (a :--> (a :--> b) :--> b)
126-
pbindParse = plam (flip (#))
127+
pbindParse :: ClosedTerm (a :--> (a :--> b) :--> b)
128+
pbindParse = phoistAcyclic $ plam (flip (#))

‎testsuites/lbt-plutus/api/Foo.lbf

Lines changed: 34 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ module Foo
33
import Foo.Bar
44
import Plutus.V1 (PlutusData, Address, AssetClass, Bytes, Credential, CurrencySymbol, Datum, DatumHash, Extended, Interval, LowerBound, Map, POSIXTime, POSIXTimeRange, PlutusData, PubKeyHash, Redeemer, RedeemerHash, ScriptHash, StakingCredential, TokenName, TxId, TxOutRef, UpperBound, Value)
55
import Plutus.V2 (OutputDatum, TxInInfo, TxOut)
6-
import Prelude (Eq, Json)
6+
import Prelude (Eq, Json, Maybe, Either, List)
77

88
prod A = (FooSum Address Value Datum)
99

@@ -29,8 +29,37 @@ derive Eq D
2929
derive Json D
3030
derive PlutusData D
3131

32-
prod E = Address AssetClass Bytes Credential CurrencySymbol Datum DatumHash (Extended POSIXTime) (Interval POSIXTime) (LowerBound POSIXTime) (Map Bytes Credential) POSIXTime POSIXTimeRange PlutusData PubKeyHash Redeemer RedeemerHash ScriptHash StakingCredential TokenName TxId TxOutRef (UpperBound POSIXTime) Value OutputDatum TxInInfo TxOut
32+
prod E a b = Address
33+
AssetClass
34+
Bytes
35+
Credential
36+
CurrencySymbol
37+
Datum
38+
DatumHash
39+
(Extended POSIXTime)
40+
(Interval POSIXTime)
41+
(LowerBound POSIXTime)
42+
(Map Bytes Credential)
43+
POSIXTime
44+
POSIXTimeRange
45+
PlutusData
46+
PubKeyHash
47+
Redeemer
48+
RedeemerHash
49+
ScriptHash
50+
StakingCredential
51+
TokenName
52+
TxId
53+
TxOutRef
54+
(UpperBound POSIXTime)
55+
Value
56+
OutputDatum
57+
TxInInfo
58+
TxOut
59+
(Maybe a)
60+
(Either a b)
61+
-- (List b) -- FIXME(bladyjoker): Using PBuiltinList in Plutarch breaks the compilation.
3362

34-
derive Eq E
35-
derive Json E
36-
derive PlutusData E
63+
derive Eq (E a b)
64+
derive Json (E a b)
65+
derive PlutusData (E a b)

0 commit comments

Comments
 (0)