From e58dfc7b97ed84dcbaada77f1c730d354a0356ed Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Thu, 12 Oct 2023 13:48:31 +0100 Subject: [PATCH 1/7] Move notes to bottom of file --- plutus-tx/src/PlutusTx/Builtins/Class.hs | 109 +++++++++++------------ 1 file changed, 54 insertions(+), 55 deletions(-) diff --git a/plutus-tx/src/PlutusTx/Builtins/Class.hs b/plutus-tx/src/PlutusTx/Builtins/Class.hs index c90b82952e4..0d30e323106 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Class.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Class.hs @@ -27,15 +27,6 @@ import PlutusTx.Bool (Bool (..)) import PlutusTx.Integer (Integer) import Prelude qualified as Haskell (String) -{- Note [Fundeps versus type families in To/FromBuiltin] -We could use a type family here to get the builtin representation of a type. After all, it's -entirely determined by the Haskell type. - -However, this is harder for the plugin to deal with. It's okay to have a type variable -for the representation type that needs to be instantiated later, but it's *not* okay to -have an irreducible type application on a type variable. So fundeps are much nicer here. --} - {-| A class witnessing the ability to convert from the builtin representation to the Haskell representation. -} @@ -62,17 +53,6 @@ instance ToBuiltin Bool BuiltinBool where {-# INLINABLE toBuiltin #-} toBuiltin b = if b then true else false -{- Note [Strict conversions to/from unit] -Converting to/from unit *should* be straightforward: just ``const ()`.` -*But* GHC is very good at optimizing this, and we sometimes use unit -where side effects matter, e.g. as the result of `trace`. So GHC will -tend to turn `fromBuiltin (trace s)` into `()`, which is wrong. - -So we want our conversions to/from unit to be strict in Haskell. This -means we need to case pointlessly on the argument, which means we need -case on unit (`chooseUnit`) as a builtin. But then it all works okay. --} - instance FromBuiltin BuiltinUnit () where -- See Note [Strict conversions to/from unit] {-# INLINABLE fromBuiltin #-} @@ -89,27 +69,6 @@ instance ToBuiltin ByteString BuiltinByteString where {-# INLINABLE toBuiltin #-} toBuiltin = BuiltinByteString -{- Note [noinline hack] -For some functions we have two conflicting desires: -- We want to have the unfolding available for the plugin. -- We don't want the function to *actually* get inlined before the plugin runs, since we rely -on being able to see the original function for some reason. - -'INLINABLE' achieves the first, but may cause the function to be inlined too soon. - -We can solve this at specific call sites by using the 'noinline' magic function from -GHC. This stops GHC from inlining it. As a bonus, it also won't be inlined if -that function is compiled later into the body of another function. - -We do therefore need to handle 'noinline' in the plugin, as it itself does not have -an unfolding. - -Another annoying quirk: even if you have 'noinline'd a function call, if the body is -a single variable, it will still inline! This is the case for the obvious definition -of 'stringToBuiltinString' (since the newtype constructor vanishes), so we have to add -some obfuscation to the body to prevent it inlining. --} - -- We can't put this in `Builtins.hs`, since that force `O0` deliberately, which prevents -- the unfoldings from going in. So we just stick it here. Fiddly. instance IsString BuiltinString where @@ -148,20 +107,6 @@ instance IsString BuiltinByteString where stringToBuiltinByteString :: Haskell.String -> BuiltinByteString stringToBuiltinByteString str = encodeUtf8 $ stringToBuiltinString str -{- Note [From/ToBuiltin instances for polymorphic builtin types] -For various technical reasons -(see Note [Representable built-in functions over polymorphic built-in types]) -it's not always easy to provide polymorphic constructors for builtin types, but -we can usually provide destructors. - -What this means in practice is that we can write a generic FromBuiltin instance -for pairs that makes use of polymorphic fst/snd builtins, but we can't write -a polymorphic ToBuiltin instance because we'd need a polymorphic version of (,). - -Instead we write monomorphic instances corresponding to monomorphic constructor -builtins that we add for specific purposes. --} - instance (FromBuiltin arep a, FromBuiltin brep b) => FromBuiltin (BuiltinPair arep brep) (a,b) where {-# INLINABLE fromBuiltin #-} fromBuiltin p = (fromBuiltin $ fst p, fromBuiltin $ snd p) @@ -221,3 +166,57 @@ instance ToBuiltin BLS12_381.Pairing.MlResult BuiltinBLS12_381_MlResult where toBuiltin = BuiltinBLS12_381_MlResult +{- Note [Fundeps versus type families in To/FromBuiltin] +We could use a type family here to get the builtin representation of a type. After all, it's +entirely determined by the Haskell type. + +However, this is harder for the plugin to deal with. It's okay to have a type variable +for the representation type that needs to be instantiated later, but it's *not* okay to +have an irreducible type application on a type variable. So fundeps are much nicer here. +-} + +{- Note [Strict conversions to/from unit] +Converting to/from unit *should* be straightforward: just ``const ()`.` +*But* GHC is very good at optimizing this, and we sometimes use unit +where side effects matter, e.g. as the result of `trace`. So GHC will +tend to turn `fromBuiltin (trace s)` into `()`, which is wrong. + +So we want our conversions to/from unit to be strict in Haskell. This +means we need to case pointlessly on the argument, which means we need +case on unit (`chooseUnit`) as a builtin. But then it all works okay. +-} + +{- Note [noinline hack] +For some functions we have two conflicting desires: +- We want to have the unfolding available for the plugin. +- We don't want the function to *actually* get inlined before the plugin runs, since we rely +on being able to see the original function for some reason. + +'INLINABLE' achieves the first, but may cause the function to be inlined too soon. + +We can solve this at specific call sites by using the 'noinline' magic function from +GHC. This stops GHC from inlining it. As a bonus, it also won't be inlined if +that function is compiled later into the body of another function. + +We do therefore need to handle 'noinline' in the plugin, as it itself does not have +an unfolding. + +Another annoying quirk: even if you have 'noinline'd a function call, if the body is +a single variable, it will still inline! This is the case for the obvious definition +of 'stringToBuiltinString' (since the newtype constructor vanishes), so we have to add +some obfuscation to the body to prevent it inlining. +-} + +{- Note [From/ToBuiltin instances for polymorphic builtin types] +For various technical reasons +(see Note [Representable built-in functions over polymorphic built-in types]) +it's not always easy to provide polymorphic constructors for builtin types, but +we can usually provide destructors. + +What this means in practice is that we can write a generic FromBuiltin instance +for pairs that makes use of polymorphic fst/snd builtins, but we can't write +a polymorphic ToBuiltin instance because we'd need a polymorphic version of (,). + +Instead we write monomorphic instances corresponding to monomorphic constructor +builtins that we add for specific purposes. +-} From fcbb593eb27e2cb78520f8ab2a8a3aaf41334db0 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Thu, 12 Oct 2023 14:18:29 +0100 Subject: [PATCH 2/7] Add notes on ToBuiltin and FromBuiltin --- plutus-tx/src/PlutusTx/Builtins/Class.hs | 34 +++++++++++++++++++----- 1 file changed, 28 insertions(+), 6 deletions(-) diff --git a/plutus-tx/src/PlutusTx/Builtins/Class.hs b/plutus-tx/src/PlutusTx/Builtins/Class.hs index 0d30e323106..59f9dcd11c0 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Class.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Class.hs @@ -1,10 +1,8 @@ -- editorconfig-checker-disable-file -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -fno-specialise #-} @@ -27,12 +25,14 @@ import PlutusTx.Bool (Bool (..)) import PlutusTx.Integer (Integer) import Prelude qualified as Haskell (String) +-- See Note [Builtin types and their Haskell versions] {-| A class witnessing the ability to convert from the builtin representation to the Haskell representation. -} class FromBuiltin arep a | arep -> a where fromBuiltin :: arep -> a +-- See Note [Builtin types and their Haskell versions] {-| A class witnessing the ability to convert from the Haskell representation to the builtin representation. -} @@ -165,6 +165,28 @@ instance ToBuiltin BLS12_381.Pairing.MlResult BuiltinBLS12_381_MlResult where {-# INLINABLE toBuiltin #-} toBuiltin = BuiltinBLS12_381_MlResult +{- Note [Builtin types and their Haskell versions] +Consider the bulitin pair type. In Plutus Tx, we have an (opaque) type for +this. It's opaque because you can't actually pattern match on it, instead you can +only in fact use the specific functions that are available as builtins. + +We _also_ have the normal Haskell pair type. This is very different: you can +pattern match on it, and you can use whatever user-defined functions you like on it. + +Users would really like to use the latter, and not the former. So we often want +to _wrap_ our builtin functions with little adapters that convert between the +"opaque builtin" "version" of a type and the "normal Haskell" "version" of a type. + +This is what the ToBuiltin and FromBuiltin classes do. They let us write wrappers +for builtins relatively consistently by just calling toBuiltin on their arguments +and fromBuiltin on the result. They shouldn't really be used otherwise. + +To keep the consistency we define dummy instances that are just the identity function +for types that don't have a separate "normall Haskell" version. For example: +integer. Integer in Plutus Tx user code _is_ the opaque builtin type, we don't +expose a different one. Essentially: if it's a datatype then there's a substantive +conversion. +-} {- Note [Fundeps versus type families in To/FromBuiltin] We could use a type family here to get the builtin representation of a type. After all, it's From f34a7eaa73d58588d0107cc6000c85d168fd1599 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Thu, 12 Oct 2023 14:28:10 +0100 Subject: [PATCH 3/7] Add notes on Lift instances --- plutus-tx/src/PlutusTx/Lift/Class.hs | 32 ++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/plutus-tx/src/PlutusTx/Lift/Class.hs b/plutus-tx/src/PlutusTx/Lift/Class.hs index db53ab767a9..6d3829c15bf 100644 --- a/plutus-tx/src/PlutusTx/Lift/Class.hs +++ b/plutus-tx/src/PlutusTx/Lift/Class.hs @@ -135,56 +135,88 @@ instance (TypeError ('Text "Int is not supported, use Integer instead")) instance uni `PLC.HasTypeLevel` Integer => Typeable uni Integer where typeRep = typeRepBuiltin +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` Integer => Lift uni Integer where lift = liftBuiltin +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` BS.ByteString => Typeable uni BS.ByteString where typeRep = typeRepBuiltin +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` BS.ByteString => Lift uni BS.ByteString where lift = liftBuiltin +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` Data => Typeable uni BuiltinData where typeRep _ = typeRepBuiltin (Proxy @Data) +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` Data => Lift uni BuiltinData where lift = liftBuiltin . builtinDataToData +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` BS.ByteString => Typeable uni BuiltinByteString where typeRep _proxyPByteString = typeRepBuiltin (Proxy @BS.ByteString) +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` BS.ByteString => Lift uni BuiltinByteString where lift = liftBuiltin . fromBuiltin +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` T.Text => Typeable uni BuiltinString where typeRep _proxyPByteString = typeRepBuiltin (Proxy @T.Text) +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` T.Text => Lift uni BuiltinString where lift = liftBuiltin . fromBuiltin +-- See Note [Lift and Typeable instances for builtins] instance (FromBuiltin arep a, uni `PLC.HasTermLevel` [a]) => Lift uni (BuiltinList arep) where lift = liftBuiltin . fromBuiltin +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.G1.Element => Typeable uni BuiltinBLS12_381_G1_Element where typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.G1.Element) +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.G1.Element => Lift uni BuiltinBLS12_381_G1_Element where lift = liftBuiltin . fromBuiltin +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.G2.Element => Typeable uni BuiltinBLS12_381_G2_Element where typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.G2.Element) +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.G2.Element => Lift uni BuiltinBLS12_381_G2_Element where lift = liftBuiltin . fromBuiltin +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.Pairing.MlResult => Typeable uni BuiltinBLS12_381_MlResult where typeRep _ = typeRepBuiltin (Proxy @PlutusCore.Crypto.BLS12_381.Pairing.MlResult) +-- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` PlutusCore.Crypto.BLS12_381.Pairing.MlResult => Lift uni BuiltinBLS12_381_MlResult where lift = liftBuiltin . fromBuiltin + +{- Note [Lift and Typeable instances for builtins] +We can, generally, lift builtin values. We just make a constant with the value inside. +However, in Plutus Tx we use opaque types for most builtin types to avoid people +trying to pattern match on them. So the types don't quite match up with what we need +to put inside the constant. + +Fortunately, we have To/FromBuiltin, which happen to do what we want. +See Note [Builtin types and their Haskell versions]. +This is arguably slightly an abuse: the versions of the types that we want in +Plutus Tx source code and the versions that we use as the implementations of +the builtin types in the universe could be different. But in practice they +aren't. So we can write fairly straightforward instances for most types. + +Similarly, for Typeable we may have to use a different type from the opaque one. +-} From 597aba48de37df01feaf18c2dbe50e40ecfb8d41 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Fri, 10 Nov 2023 12:12:39 +0000 Subject: [PATCH 4/7] Remove dubious instances --- plutus-tx/src/PlutusTx/Lift/Class.hs | 4 ---- plutus-tx/src/PlutusTx/Lift/Instances.hs | 2 -- 2 files changed, 6 deletions(-) diff --git a/plutus-tx/src/PlutusTx/Lift/Class.hs b/plutus-tx/src/PlutusTx/Lift/Class.hs index 6d3829c15bf..0322424b5c7 100644 --- a/plutus-tx/src/PlutusTx/Lift/Class.hs +++ b/plutus-tx/src/PlutusTx/Lift/Class.hs @@ -143,10 +143,6 @@ instance uni `PLC.HasTermLevel` Integer => Lift uni Integer where instance uni `PLC.HasTypeLevel` BS.ByteString => Typeable uni BS.ByteString where typeRep = typeRepBuiltin --- See Note [Lift and Typeable instances for builtins] -instance uni `PLC.HasTermLevel` BS.ByteString => Lift uni BS.ByteString where - lift = liftBuiltin - -- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` Data => Typeable uni BuiltinData where typeRep _ = typeRepBuiltin (Proxy @Data) diff --git a/plutus-tx/src/PlutusTx/Lift/Instances.hs b/plutus-tx/src/PlutusTx/Lift/Instances.hs index 5eaf5bc7685..d5132023e16 100644 --- a/plutus-tx/src/PlutusTx/Lift/Instances.hs +++ b/plutus-tx/src/PlutusTx/Lift/Instances.hs @@ -14,7 +14,6 @@ {-# OPTIONS_GHC -Wno-orphans #-} module PlutusTx.Lift.Instances () where -import PlutusCore.Data import PlutusTx.Bool (Bool (..)) import PlutusTx.Either (Either (..)) import PlutusTx.Lift.TH @@ -34,4 +33,3 @@ makeLift ''(,,) makeLift ''(,,,) makeLift ''(,,,,) -makeLift ''Data From 645d3bb85a67a4f7014ef6b0f02bd467a07bfa17 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Fri, 10 Nov 2023 12:15:37 +0000 Subject: [PATCH 5/7] Add missing instances --- plutus-tx/src/PlutusTx/Lift/Class.hs | 35 ++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/plutus-tx/src/PlutusTx/Lift/Class.hs b/plutus-tx/src/PlutusTx/Lift/Class.hs index 0322424b5c7..240ce9efc54 100644 --- a/plutus-tx/src/PlutusTx/Lift/Class.hs +++ b/plutus-tx/src/PlutusTx/Lift/Class.hs @@ -31,7 +31,7 @@ import PlutusCore.Quote import PlutusIR.MkPir import PlutusTx.Builtins import PlutusTx.Builtins.Class (FromBuiltin) -import PlutusTx.Builtins.Internal (BuiltinList) +import PlutusTx.Builtins.Internal (BuiltinBool, BuiltinList, BuiltinPair, BuiltinUnit) import Language.Haskell.TH qualified as TH hiding (newName) @@ -115,7 +115,7 @@ instance Typeable uni (->) where -- Primitives typeRepBuiltin - :: forall (a :: GHC.Type) uni fun. uni `PLC.HasTypeLevel` a + :: forall k (a :: k) uni fun. uni `PLC.HasTypeLevel` a => Proxy a -> RTCompile uni fun (Type TyName uni ()) typeRepBuiltin (_ :: Proxy a) = pure $ mkTyBuiltin @_ @a () @@ -153,7 +153,7 @@ instance uni `PLC.HasTermLevel` Data => Lift uni BuiltinData where -- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` BS.ByteString => Typeable uni BuiltinByteString where - typeRep _proxyPByteString = typeRepBuiltin (Proxy @BS.ByteString) + typeRep _proxyByteString = typeRepBuiltin (Proxy @BS.ByteString) -- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` BS.ByteString => Lift uni BuiltinByteString where @@ -161,16 +161,43 @@ instance uni `PLC.HasTermLevel` BS.ByteString => Lift uni BuiltinByteString wher -- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` T.Text => Typeable uni BuiltinString where - typeRep _proxyPByteString = typeRepBuiltin (Proxy @T.Text) + typeRep _proxyByteString = typeRepBuiltin (Proxy @T.Text) -- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTermLevel` T.Text => Lift uni BuiltinString where lift = liftBuiltin . fromBuiltin +-- See Note [Lift and Typeable instances for builtins] +instance uni `PLC.HasTypeLevel` () => Typeable uni BuiltinUnit where + typeRep _proxyUnit = typeRepBuiltin (Proxy @()) + +-- See Note [Lift and Typeable instances for builtins] +instance uni `PLC.HasTermLevel` () => Lift uni BuiltinUnit where + lift = liftBuiltin . fromBuiltin + +-- See Note [Lift and Typeable instances for builtins] +instance uni `PLC.HasTypeLevel` Bool => Typeable uni BuiltinBool where + typeRep _proxyBool = typeRepBuiltin (Proxy @Bool) + +-- See Note [Lift and Typeable instances for builtins] +instance uni `PLC.HasTermLevel` Bool => Lift uni BuiltinBool where + lift = liftBuiltin . fromBuiltin + +-- See Note [Lift and Typeable instances for builtins] +instance uni `PLC.HasTypeLevel` [] => Typeable uni BuiltinList where + typeRep _proxyBuiltinList = typeRepBuiltin (Proxy @[]) + -- See Note [Lift and Typeable instances for builtins] instance (FromBuiltin arep a, uni `PLC.HasTermLevel` [a]) => Lift uni (BuiltinList arep) where lift = liftBuiltin . fromBuiltin +instance uni `PLC.HasTypeLevel` (,) => Typeable uni BuiltinPair where + typeRep _proxyBuiltinPair = typeRepBuiltin (Proxy @(,)) + +instance (FromBuiltin arep a, FromBuiltin brep b, uni `PLC.HasTermLevel` (a, b)) => + Lift uni (BuiltinPair arep brep) where + lift = liftBuiltin . fromBuiltin + -- See Note [Lift and Typeable instances for builtins] instance uni `PLC.HasTypeLevel` PlutusCore.Crypto.BLS12_381.G1.Element => Typeable uni BuiltinBLS12_381_G1_Element where From 8993865aea6f0c1438756a1b2ba42c4191b32b5b Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Tue, 14 Nov 2023 10:30:21 +0000 Subject: [PATCH 6/7] Typos --- plutus-tx/src/PlutusTx/Builtins/Class.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/plutus-tx/src/PlutusTx/Builtins/Class.hs b/plutus-tx/src/PlutusTx/Builtins/Class.hs index 59f9dcd11c0..2eeb5645fa3 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Class.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Class.hs @@ -166,7 +166,7 @@ instance ToBuiltin BLS12_381.Pairing.MlResult BuiltinBLS12_381_MlResult where toBuiltin = BuiltinBLS12_381_MlResult {- Note [Builtin types and their Haskell versions] -Consider the bulitin pair type. In Plutus Tx, we have an (opaque) type for +Consider the builtin pair type. In Plutus Tx, we have an (opaque) type for this. It's opaque because you can't actually pattern match on it, instead you can only in fact use the specific functions that are available as builtins. @@ -198,7 +198,7 @@ have an irreducible type application on a type variable. So fundeps are much nic -} {- Note [Strict conversions to/from unit] -Converting to/from unit *should* be straightforward: just ``const ()`.` +Converting to/from unit *should* be straightforward: just `const ()`. *But* GHC is very good at optimizing this, and we sometimes use unit where side effects matter, e.g. as the result of `trace`. So GHC will tend to turn `fromBuiltin (trace s)` into `()`, which is wrong. From 5d7ea0a72a50cb08109b806f68e87cb8827a2443 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Wed, 22 Nov 2023 12:26:38 +0000 Subject: [PATCH 7/7] Add comment about weirdness --- plutus-tx/src/PlutusTx/Builtins/Class.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/plutus-tx/src/PlutusTx/Builtins/Class.hs b/plutus-tx/src/PlutusTx/Builtins/Class.hs index 2eeb5645fa3..a6de8b9223a 100644 --- a/plutus-tx/src/PlutusTx/Builtins/Class.hs +++ b/plutus-tx/src/PlutusTx/Builtins/Class.hs @@ -181,11 +181,17 @@ This is what the ToBuiltin and FromBuiltin classes do. They let us write wrapper for builtins relatively consistently by just calling toBuiltin on their arguments and fromBuiltin on the result. They shouldn't really be used otherwise. -To keep the consistency we define dummy instances that are just the identity function -for types that don't have a separate "normall Haskell" version. For example: -integer. Integer in Plutus Tx user code _is_ the opaque builtin type, we don't -expose a different one. Essentially: if it's a datatype then there's a substantive -conversion. +Ideally, we would not have instances for types which don't have a different +Haskell representation type, such as Integer. Integer in Plutus Tx user code _is_ the +opaque builtin type, we don't expose a different one. So there's no conversion to +do. However, this interacts badly with the instances for polymorphic builtin types, which +also convert the type _inside_ them. (This is necessary to avoid doing multiple +traversals of the type, e.g. we don't want to turn a builtin list into a Haskell +list, and then traverse it again to conver the contents). Then we _need_ instances +for all builtin types, even if they don't quite make sense. + +Possibly this indicates that these type classes are a bit too 'ad-hoc' and we should +get rid of them. -} {- Note [Fundeps versus type families in To/FromBuiltin]