Split 'Has*' into 'From*' and 'To*' again

IntersectMBO · ana-pantilie · May 21, 2024 · Apr 29, 2024 · Apr 29, 2024 · Apr 29, 2024
commit 94ff0ff38e4a5f65a82525c52ce788992da0badd
diff --git a/plutus-tx/src/PlutusTx/Builtins/Internal.hs b/plutus-tx/src/PlutusTx/Builtins/Internal.hs
@@ -41,7 +41,6 @@ import PlutusCore.Crypto.Ed25519 qualified
 import PlutusCore.Crypto.Hash qualified as Hash
 import PlutusCore.Crypto.Secp256k1 qualified
 import PlutusCore.Data qualified as PLC
-import PlutusCore.Default qualified as PLC
 import PlutusCore.Pretty (Pretty (..), display)
 import Prettyprinter (viaShow)
 
@@ -366,15 +365,6 @@ fst (BuiltinPair (a, _)) = a
 snd :: BuiltinPair a b -> b
 snd (BuiltinPair (_, b)) = b
 
-{-# NOINLINE mkPair #-}
-mkPair
-    :: PLC.DefaultUni (PLC.Esc a)
-    -> PLC.DefaultUni (PLC.Esc b)
-    -> aAsBuiltin
-    -> bAsBuiltin
-    -> BuiltinPair aAsBuiltin bAsBuiltin
-mkPair _ _ x y = BuiltinPair (x, y)
-
 {-# NOINLINE mkPairData #-}
 mkPairData :: BuiltinData -> BuiltinData -> BuiltinPair BuiltinData BuiltinData
 mkPairData d1 d2 = BuiltinPair (d1, d2)
@@ -413,10 +403,6 @@ chooseList :: BuiltinList a -> b -> b -> b
 chooseList (BuiltinList [])    b1 _ = b1
 chooseList (BuiltinList (_:_)) _ b2 = b2
 
-{-# NOINLINE mkNil #-}
-mkNil :: PLC.DefaultUni (PLC.Esc a) -> BuiltinList aAsBuiltin
-mkNil _ = BuiltinList []
-
 {-# NOINLINE mkNilData #-}
 mkNilData :: BuiltinUnit -> BuiltinList BuiltinData
 mkNilData _ = BuiltinList []

diff --git a/plutus-tx/src/PlutusTx/Builtins/IsBuiltin.hs b/plutus-tx/src/PlutusTx/Builtins/IsBuiltin.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts         #-}
+{-# LANGUAGE FlexibleInstances        #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeApplications         #-}
 {-# LANGUAGE TypeFamilies             #-}
@@ -11,7 +12,6 @@
 
 module PlutusTx.Builtins.IsBuiltin where
 
-import PlutusCore qualified as PLC
 import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 (Element)
 import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 (Element)
 import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing (MlResult)
@@ -59,48 +59,56 @@ instance IsString BuiltinString where
     -- See Note [noinline hack]
     fromString = Magic.noinline stringToBuiltinString
 
-type IsBuiltin :: GHC.Type -> GHC.Constraint
-class PLC.DefaultUni `PLC.Contains` (FromBuiltin a) => IsBuiltin a where
+type HasFromBuiltin :: GHC.Type -> GHC.Constraint
+class HasFromBuiltin a where
     type FromBuiltin a
     fromBuiltin :: a -> FromBuiltin a
+
+type HasToBuiltin :: GHC.Type -> GHC.Constraint
+class HasToBuiltin a where
     toBuiltin :: FromBuiltin a -> a
 
-instance IsBuiltin BuiltinInteger where
+instance HasFromBuiltin BuiltinInteger where
     type FromBuiltin BuiltinInteger = Integer
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin = id
+instance HasToBuiltin BuiltinInteger where
     {-# INLINABLE toBuiltin #-}
     toBuiltin = id
 
-instance IsBuiltin BuiltinByteString where
+instance HasFromBuiltin BuiltinByteString where
     type FromBuiltin BuiltinByteString = ByteString
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin (BuiltinByteString b) = b
+instance HasToBuiltin BuiltinByteString where
     {-# INLINABLE toBuiltin #-}
     toBuiltin = BuiltinByteString
 
-instance IsBuiltin BuiltinString where
+instance HasFromBuiltin BuiltinString where
     type FromBuiltin BuiltinString = Text
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin (BuiltinString t) = t
+instance HasToBuiltin BuiltinString where
     {-# INLINABLE toBuiltin #-}
     toBuiltin = BuiltinString
 
-instance IsBuiltin BuiltinUnit where
+instance HasFromBuiltin BuiltinUnit where
     type FromBuiltin BuiltinUnit = ()
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin u = chooseUnit u ()
+instance HasToBuiltin BuiltinUnit where
     {-# INLINABLE toBuiltin #-}
     toBuiltin x = case x of () -> unitval
 
-instance IsBuiltin BuiltinBool where
+instance HasFromBuiltin BuiltinBool where
     type FromBuiltin BuiltinBool = Bool
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin b = ifThenElse b True False
+instance HasToBuiltin BuiltinBool where
     {-# INLINABLE toBuiltin #-}
     toBuiltin b = if b then true else false
 
-instance IsBuiltin a => IsBuiltin (BuiltinList a) where
+instance HasFromBuiltin a => HasFromBuiltin (BuiltinList a) where
     type FromBuiltin (BuiltinList a) = [FromBuiltin a]
 
     {-# INLINABLE fromBuiltin #-}
@@ -115,50 +123,56 @@ instance IsBuiltin a => IsBuiltin (BuiltinList a) where
           -- need to do the manual laziness ourselves.
           go l = chooseList l (\_ -> []) (\_ -> fromBuiltin (head l) : go (tail l)) unitval
 
+instance HasToBuiltin (BuiltinList BuiltinData) where
+    {-# INLINE toBuiltin #-}
+    toBuiltin = goList where
+        goList :: [Data] -> BuiltinList BuiltinData
+        goList []     = mkNilData unitval
+        goList (d:ds) = mkCons (toBuiltin d) (goList ds)
+
+instance HasToBuiltin (BuiltinList (BuiltinPair BuiltinData BuiltinData)) where
     {-# INLINE toBuiltin #-}
     toBuiltin = goList where
-        goList :: [FromBuiltin a] -> BuiltinList a
-        goList []     = mkNil @(FromBuiltin a) (Magic.inline PLC.knownUni)
+        goList :: [(Data, Data)] -> BuiltinList (BuiltinPair BuiltinData BuiltinData)
+        goList []     = mkNilPairData unitval
         goList (d:ds) = mkCons (toBuiltin d) (goList ds)
 
-instance (IsBuiltin a, IsBuiltin b) => IsBuiltin (BuiltinPair a b) where
+instance (HasFromBuiltin a, HasFromBuiltin b) => HasFromBuiltin (BuiltinPair a b) where
     type FromBuiltin (BuiltinPair a b) = (FromBuiltin a, FromBuiltin b)
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin p = (fromBuiltin $ fst p, fromBuiltin $ snd p)
+instance HasToBuiltin (BuiltinPair BuiltinData BuiltinData) where
     {-# INLINABLE toBuiltin #-}
-    toBuiltin (d1, d2) =
-        mkPair
-            @(FromBuiltin a)
-            @(FromBuiltin b)
-            (Magic.inline PLC.knownUni)
-            (Magic.inline PLC.knownUni)
-            (toBuiltin d1)
-            (toBuiltin d2)
-
-instance IsBuiltin BuiltinData where
+    toBuiltin (d1, d2) = mkPairData (toBuiltin d1) (toBuiltin d2)
+
+instance HasFromBuiltin BuiltinData where
     type FromBuiltin BuiltinData = Data
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin (BuiltinData t) = t
+instance HasToBuiltin BuiltinData where
     {-# INLINABLE toBuiltin #-}
     toBuiltin = BuiltinData
 
-instance IsBuiltin BuiltinBLS12_381_G1_Element where
+instance HasFromBuiltin BuiltinBLS12_381_G1_Element where
     type FromBuiltin BuiltinBLS12_381_G1_Element = BLS12_381.G1.Element
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin (BuiltinBLS12_381_G1_Element a) = a
+instance HasToBuiltin BuiltinBLS12_381_G1_Element where
     {-# INLINABLE toBuiltin #-}
     toBuiltin = BuiltinBLS12_381_G1_Element
 
-instance IsBuiltin BuiltinBLS12_381_G2_Element where
+instance HasFromBuiltin BuiltinBLS12_381_G2_Element where
     type FromBuiltin BuiltinBLS12_381_G2_Element = BLS12_381.G2.Element
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin (BuiltinBLS12_381_G2_Element a) = a
+instance HasToBuiltin BuiltinBLS12_381_G2_Element where
     {-# INLINABLE toBuiltin #-}
     toBuiltin = BuiltinBLS12_381_G2_Element
 
-instance IsBuiltin BuiltinBLS12_381_MlResult where
+instance HasFromBuiltin BuiltinBLS12_381_MlResult where
     type FromBuiltin BuiltinBLS12_381_MlResult = BLS12_381.Pairing.MlResult
     {-# INLINABLE fromBuiltin #-}
     fromBuiltin (BuiltinBLS12_381_MlResult a) = a
+instance HasToBuiltin BuiltinBLS12_381_MlResult where
     {-# INLINABLE toBuiltin #-}
     toBuiltin = BuiltinBLS12_381_MlResult
diff --git a/plutus-tx/src/PlutusTx/Builtins/IsOpaque.hs b/plutus-tx/src/PlutusTx/Builtins/IsOpaque.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts         #-}
+{-# LANGUAGE FlexibleInstances        #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeApplications         #-}
 {-# LANGUAGE TypeFamilies             #-}
@@ -11,60 +12,63 @@
 
 module PlutusTx.Builtins.IsOpaque where
 
-import PlutusCore qualified as PLC
 import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1 (Element)
 import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2 (Element)
 import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing (MlResult)
 import PlutusTx.Base (id, ($))
 import PlutusTx.Bool (Bool (..))
 import PlutusTx.Builtins.Internal
-import PlutusTx.Builtins.IsBuiltin (FromBuiltin)
 
 import Data.Kind qualified as GHC
-import GHC.Magic qualified as Magic
 
-type IsOpaque :: GHC.Type -> GHC.Constraint
-class PLC.DefaultUni `PLC.Contains` FromBuiltin a => IsOpaque a where
+type HasFromOpaque :: GHC.Type -> GHC.Constraint
+class HasFromOpaque a where
     type FromOpaque a
     fromOpaque :: a -> FromOpaque a
+class HasToOpaque a where
     toOpaque :: FromOpaque a -> a
 
-instance IsOpaque BuiltinInteger where
+instance HasFromOpaque BuiltinInteger where
     type FromOpaque BuiltinInteger = BuiltinInteger
     {-# INLINABLE fromOpaque #-}
     fromOpaque = id
+instance HasToOpaque BuiltinInteger where
     {-# INLINABLE toOpaque #-}
     toOpaque = id
 
-instance IsOpaque BuiltinByteString where
+instance HasFromOpaque BuiltinByteString where
     type FromOpaque BuiltinByteString = BuiltinByteString
     {-# INLINABLE fromOpaque #-}
     fromOpaque = id
+instance HasToOpaque BuiltinByteString where
     {-# INLINABLE toOpaque #-}
     toOpaque = id
 
-instance IsOpaque BuiltinString where
+instance HasFromOpaque BuiltinString where
     type FromOpaque BuiltinString = BuiltinString
     {-# INLINABLE fromOpaque #-}
     fromOpaque = id
+instance HasToOpaque BuiltinString where
     {-# INLINABLE toOpaque #-}
     toOpaque = id
 
-instance IsOpaque BuiltinUnit where
+instance HasFromOpaque BuiltinUnit where
     type FromOpaque BuiltinUnit = ()
     {-# INLINABLE fromOpaque #-}
     fromOpaque u = chooseUnit u ()
+instance HasToOpaque BuiltinUnit where
     {-# INLINABLE toOpaque #-}
     toOpaque x = case x of () -> unitval
 
-instance IsOpaque BuiltinBool where
+instance HasFromOpaque BuiltinBool where
     type FromOpaque BuiltinBool = Bool
     {-# INLINABLE fromOpaque #-}
     fromOpaque b = ifThenElse b True False
+instance HasToOpaque BuiltinBool where
     {-# INLINABLE toOpaque #-}
     toOpaque b = if b then true else false
 
-instance IsOpaque a => IsOpaque (BuiltinList a) where
+instance HasFromOpaque a => HasFromOpaque (BuiltinList a) where
     type FromOpaque (BuiltinList a) = [FromOpaque a]
 
     {-# INLINABLE fromOpaque #-}
@@ -79,50 +83,56 @@ instance IsOpaque a => IsOpaque (BuiltinList a) where
           -- need to do the manual laziness ourselves.
           go l = chooseList l (\_ -> []) (\_ -> fromOpaque (head l) : go (tail l)) unitval
 
+instance HasToOpaque (BuiltinList BuiltinData) where
     {-# INLINE toOpaque #-}
     toOpaque = goList where
-        goList :: [FromOpaque a] -> BuiltinList a
-        goList []     = mkNil @(FromBuiltin a) (Magic.inline PLC.knownUni)
+        goList :: [BuiltinData] -> BuiltinList BuiltinData
+        goList []     = mkNilData unitval
         goList (d:ds) = mkCons (toOpaque d) (goList ds)
 
-instance (IsOpaque a, IsOpaque b) => IsOpaque (BuiltinPair a b) where
+instance HasToOpaque (BuiltinList (BuiltinPair BuiltinData BuiltinData)) where
+    {-# INLINE toOpaque #-}
+    toOpaque = goList where
+        goList :: [(BuiltinData, BuiltinData)] -> BuiltinList (BuiltinPair BuiltinData BuiltinData)
+        goList []     = mkNilPairData unitval
+        goList (d:ds) = mkCons (toOpaque d) (goList ds)
+
+instance (HasFromOpaque a, HasFromOpaque b) => HasFromOpaque (BuiltinPair a b) where
     type FromOpaque (BuiltinPair a b) = (FromOpaque a, FromOpaque b)
     {-# INLINABLE fromOpaque #-}
     fromOpaque p = (fromOpaque $ fst p, fromOpaque $ snd p)
+instance HasToOpaque (BuiltinPair BuiltinData BuiltinData) where
     {-# INLINABLE toOpaque #-}
-    toOpaque (d1, d2) =
-        mkPair
-            @(FromBuiltin a)
-            @(FromBuiltin b)
-            (Magic.inline PLC.knownUni)
-            (Magic.inline PLC.knownUni)
-            (toOpaque d1)
-            (toOpaque d2)
-
-instance IsOpaque BuiltinData where
+    toOpaque (d1, d2) = mkPairData d1 d2
+
+instance HasFromOpaque BuiltinData where
     type FromOpaque BuiltinData = BuiltinData
     {-# INLINABLE fromOpaque #-}
     fromOpaque = id
+instance HasToOpaque BuiltinData where
     {-# INLINABLE toOpaque #-}
     toOpaque = id
 
-instance IsOpaque BuiltinBLS12_381_G1_Element where
+instance HasFromOpaque BuiltinBLS12_381_G1_Element where
     type FromOpaque BuiltinBLS12_381_G1_Element = BLS12_381.G1.Element
     {-# INLINABLE fromOpaque #-}
     fromOpaque (BuiltinBLS12_381_G1_Element a) = a
+instance HasToOpaque BuiltinBLS12_381_G1_Element where
     {-# INLINABLE toOpaque #-}
     toOpaque = BuiltinBLS12_381_G1_Element
 
-instance IsOpaque BuiltinBLS12_381_G2_Element where
+instance HasFromOpaque BuiltinBLS12_381_G2_Element where
     type FromOpaque BuiltinBLS12_381_G2_Element = BLS12_381.G2.Element
     {-# INLINABLE fromOpaque #-}
     fromOpaque (BuiltinBLS12_381_G2_Element a) = a
+instance HasToOpaque BuiltinBLS12_381_G2_Element where
     {-# INLINABLE toOpaque #-}
     toOpaque = BuiltinBLS12_381_G2_Element
 
-instance IsOpaque BuiltinBLS12_381_MlResult where
+instance HasFromOpaque BuiltinBLS12_381_MlResult where
     type FromOpaque BuiltinBLS12_381_MlResult = BLS12_381.Pairing.MlResult
     {-# INLINABLE fromOpaque #-}
     fromOpaque (BuiltinBLS12_381_MlResult a) = a
+instance HasToOpaque BuiltinBLS12_381_MlResult where
     {-# INLINABLE toOpaque #-}
     toOpaque = BuiltinBLS12_381_MlResult
diff --git 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.Internal (BuiltinBool, BuiltinList, BuiltinPair, BuiltinUnit)
-import PlutusTx.Builtins.IsBuiltin (FromBuiltin, IsBuiltin)
+import PlutusTx.Builtins.IsBuiltin (FromBuiltin, HasFromBuiltin)
 
 import Language.Haskell.TH qualified as TH hiding (newName)
 
@@ -188,14 +188,17 @@ instance uni `PLC.HasTypeLevel` [] => Typeable uni BuiltinList where
     typeRep _proxyBuiltinList = typeRepBuiltin (Proxy @[])
 
 -- See Note [Lift and Typeable instances for builtins]
-instance (IsBuiltin a, uni `PLC.HasTermLevel` [FromBuiltin a]) => Lift uni (BuiltinList a) where
+instance (HasFromBuiltin a, uni `PLC.HasTermLevel` [FromBuiltin a]) =>
+        Lift uni (BuiltinList a) where
     lift = liftBuiltin . fromBuiltin
 
 instance uni `PLC.HasTypeLevel` (,) => Typeable uni BuiltinPair where
     typeRep _proxyBuiltinPair = typeRepBuiltin (Proxy @(,))
 
-instance (IsBuiltin a, IsBuiltin b, uni `PLC.HasTermLevel` (FromBuiltin a, FromBuiltin b)) =>
-        Lift uni (BuiltinPair a b) where
+instance
+        ( HasFromBuiltin a, HasFromBuiltin b
+        , uni `PLC.HasTermLevel` (FromBuiltin a, FromBuiltin b)
+        ) => Lift uni (BuiltinPair a b) where
     lift = liftBuiltin . fromBuiltin
 
 -- See Note [Lift and Typeable instances for builtins]