Merge pull request #137 from Plutonomicon/staging-cleanup

Basic scattered cleanup

Plutarch/Bool.hs

@@ -17,7 +17,13 @@ module Plutarch.Bool (
 ) where
 
 import Plutarch (PlutusType (PInner, pcon', pmatch'), punsafeBuiltin)
-import Plutarch.Lift (DerivePConstantViaCoercible (DerivePConstantViaCoercible), PConstant, PLifted, PUnsafeLiftDecl, pconstant)
+import Plutarch.Lift (
+  DerivePConstantViaCoercible (DerivePConstantViaCoercible),
+  PConstant,
+  PLifted,
+  PUnsafeLiftDecl,
+  pconstant,
+ )
 import Plutarch.Prelude
 import qualified PlutusCore as PLC
 

Plutarch/Builtin.hs

@@ -27,7 +27,18 @@ import Plutarch (PlutusType (..), punsafeBuiltin, punsafeCoerce)
 import Plutarch.Bool (PBool (..), PEq, pif', (#==))
 import Plutarch.ByteString (PByteString)
 import Plutarch.Integer (PInteger)
-import Plutarch.Lift (DerivePConstantViaCoercible (DerivePConstantViaCoercible), PConstant, PConstantRepr, PConstanted, PLift, PLifted, PUnsafeLiftDecl, pconstant, pconstantFromRepr, pconstantToRepr)
+import Plutarch.Lift (
+  DerivePConstantViaCoercible (DerivePConstantViaCoercible),
+  PConstant,
+  PConstantRepr,
+  PConstanted,
+  PLift,
+  PLifted,
+  PUnsafeLiftDecl,
+  pconstant,
+  pconstantFromRepr,
+  pconstantToRepr,
+ )
 import Plutarch.List (PListLike (..), plistEquals)
 import Plutarch.Prelude
 import qualified PlutusCore as PLC

Plutarch/ByteString.hs

@@ -19,7 +19,13 @@ import GHC.Stack (HasCallStack)
 import Plutarch (punsafeBuiltin)
 import Plutarch.Bool (PEq, POrd, (#<), (#<=), (#==))
 import Plutarch.Integer (PInteger)
-import Plutarch.Lift (DerivePConstantViaCoercible (DerivePConstantViaCoercible), PConstant, PLifted, PUnsafeLiftDecl, pconstant)
+import Plutarch.Lift (
+  DerivePConstantViaCoercible (DerivePConstantViaCoercible),
+  PConstant,
+  PLifted,
+  PUnsafeLiftDecl,
+  pconstant,
+ )
 import Plutarch.Prelude
 import qualified PlutusCore as PLC
 

Plutarch/DataRepr.hs

@@ -58,7 +58,7 @@ pindexDataRepr n = phoistAcyclic $
     plet (pasConstr #$ pasData t) $ \d ->
       let i :: Term _ PInteger = pfstBuiltin # d
        in pif
-            (i #== (fromInteger $ toInteger $ natVal $ n))
+            (i #== fromInteger (natVal n))
             (punsafeCoerce $ psndBuiltin # d :: Term _ (PDataList _))
             perror
 
@@ -70,7 +70,7 @@ pindexDataList n =
       punsafeIndex @PBuiltinList @PData # ind
   where
     ind :: Term s PInteger
-    ind = fromInteger $ toInteger $ natVal n
+    ind = fromInteger $ natVal n
 
 data DataReprHandlers (out :: PType) (def :: [[PType]]) (s :: S) where
   DRHNil :: DataReprHandlers out '[] s

Plutarch/Integer.hs

@@ -5,7 +5,13 @@ module Plutarch.Integer (PInteger, PIntegral (..)) where
 
 import Plutarch (punsafeBuiltin)
 import Plutarch.Bool (PEq, POrd, pif, (#<), (#<=), (#==))
-import Plutarch.Lift (DerivePConstantViaCoercible (DerivePConstantViaCoercible), PConstant, PLifted, PUnsafeLiftDecl, pconstant)
+import Plutarch.Lift (
+  DerivePConstantViaCoercible (DerivePConstantViaCoercible),
+  PConstant,
+  PLifted,
+  PUnsafeLiftDecl,
+  pconstant,
+ )
 import Plutarch.Prelude
 import qualified PlutusCore as PLC
 

Plutarch/Internal.hs

@@ -82,8 +82,10 @@ data RawTerm
 
 hashRawTerm' :: HashAlgorithm alg => RawTerm -> Context alg -> Context alg
 hashRawTerm' (RVar x) = flip hashUpdate ("0" :: BS.ByteString) . flip hashUpdate (F.flat (fromIntegral x :: Integer))
-hashRawTerm' (RLamAbs n x) = flip hashUpdate ("1" :: BS.ByteString) . flip hashUpdate (F.flat (fromIntegral n :: Integer)) . hashRawTerm' x
-hashRawTerm' (RApply x y) = flip hashUpdate ("2" :: BS.ByteString) . hashRawTerm' x . flip (foldl' $ flip hashRawTerm') y
+hashRawTerm' (RLamAbs n x) =
+  flip hashUpdate ("1" :: BS.ByteString) . flip hashUpdate (F.flat (fromIntegral n :: Integer)) . hashRawTerm' x
+hashRawTerm' (RApply x y) =
+  flip hashUpdate ("2" :: BS.ByteString) . hashRawTerm' x . flip (foldl' $ flip hashRawTerm') y
 hashRawTerm' (RForce x) = flip hashUpdate ("3" :: BS.ByteString) . hashRawTerm' x
 hashRawTerm' (RDelay x) = flip hashUpdate ("4" :: BS.ByteString) . hashRawTerm' x
 hashRawTerm' (RConstant x) = flip hashUpdate ("5" :: BS.ByteString) . flip hashUpdate (F.flat x)
@@ -105,7 +107,7 @@ mapTerm f (TermResult t d) = TermResult (f t) d
 mkTermRes :: RawTerm -> TermResult
 mkTermRes r = TermResult r []
 
--- | Type of `s`.
+-- | Type of `s` in `Term s a`. See: "What is the `s`?" section on the Plutarch guide.
 data S
 
 -- | Shorthand for Plutarch types.
@@ -313,10 +315,20 @@ phoistAcyclic t = Term $ \_ -> case asRawTerm t 0 of
        in TermResult (RHoisted hoisted) (hoisted : getDeps t')
     Left e -> error $ "Hoisted term errs! " <> show e
 
-rawTermToUPLC :: (HoistedTerm -> Natural -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()) -> Natural -> RawTerm -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()
+rawTermToUPLC ::
+  (HoistedTerm -> Natural -> UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()) ->
+  Natural ->
+  RawTerm ->
+  UPLC.Term DeBruijn UPLC.DefaultUni UPLC.DefaultFun ()
 rawTermToUPLC _ _ (RVar i) = UPLC.Var () (DeBruijn . Index $ i + 1) -- Why the fuck does it start from 1 and not 0?
-rawTermToUPLC m l (RLamAbs n t) = foldr (.) id (replicate (fromIntegral $ n + 1) $ UPLC.LamAbs () (DeBruijn . Index $ 0)) $ (rawTermToUPLC m (l + n + 1) t)
-rawTermToUPLC m l (RApply x y) = foldr (.) id ((\y' t -> UPLC.Apply () t (rawTermToUPLC m l y')) <$> y) $ (rawTermToUPLC m l x)
+rawTermToUPLC m l (RLamAbs n t) =
+  foldr
+    (.)
+    id
+    (replicate (fromIntegral $ n + 1) $ UPLC.LamAbs () (DeBruijn . Index $ 0))
+    $ (rawTermToUPLC m (l + n + 1) t)
+rawTermToUPLC m l (RApply x y) =
+  foldr (.) id ((\y' t -> UPLC.Apply () t (rawTermToUPLC m l y')) <$> y) $ (rawTermToUPLC m l x)
 rawTermToUPLC m l (RDelay t) = UPLC.Delay () (rawTermToUPLC m l t)
 rawTermToUPLC m l (RForce t) = UPLC.Force () (rawTermToUPLC m l t)
 rawTermToUPLC _ _ (RBuiltin f) = UPLC.Builtin () f
@@ -335,13 +347,23 @@ compile' t =
       f n Nothing = (True, Just n)
       f _ (Just n) = (False, Just n)
 
-      g :: HoistedTerm -> (M.Map Dig Natural, [(Natural, RawTerm)], Natural) -> (M.Map Dig Natural, [(Natural, RawTerm)], Natural)
+      g ::
+        HoistedTerm ->
+        (M.Map Dig Natural, [(Natural, RawTerm)], Natural) ->
+        (M.Map Dig Natural, [(Natural, RawTerm)], Natural)
       g (HoistedTerm hash term) (map, defs, n) = case M.alterF (f n) hash map of
         (True, map) -> (map, (n, term) : defs, n + 1)
         (False, map) -> (map, defs, n)
 
       toInline :: S.Set Dig
-      toInline = S.fromList . fmap (\(HoistedTerm hash _) -> hash) . (head <$>) . filter ((== 1) . length) . groupBy (\(HoistedTerm x _) (HoistedTerm y _) -> x == y) . sortOn (\(HoistedTerm hash _) -> hash) $ deps
+      toInline =
+        S.fromList
+          . fmap (\(HoistedTerm hash _) -> hash)
+          . (head <$>)
+          . filter ((== 1) . length)
+          . groupBy (\(HoistedTerm x _) (HoistedTerm y _) -> x == y)
+          . sortOn (\(HoistedTerm hash _) -> hash)
+          $ deps
 
       -- map: term -> de Bruijn level
       -- defs: the terms, level 0 is last
@@ -354,7 +376,11 @@ compile' t =
 
       body = rawTermToUPLC map' n t'
 
-      wrapped = foldl' (\b (lvl, def) -> UPLC.Apply () (UPLC.LamAbs () (DeBruijn . Index $ 0) b) (rawTermToUPLC map' lvl def)) body defs
+      wrapped =
+        foldl'
+          (\b (lvl, def) -> UPLC.Apply () (UPLC.LamAbs () (DeBruijn . Index $ 0) b) (rawTermToUPLC map' lvl def))
+          body
+          defs
    in wrapped
 
 -- | Compile a (closed) Plutus Term to a usable script

Plutarch/Lift.hs

@@ -3,7 +3,22 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 
-module Plutarch.Lift (PConstant (..), PUnsafeLiftDecl (..), PLift, pconstant, plift, plift', LiftError, DerivePConstantViaCoercible (..), DerivePConstantViaNewtype (..)) where
+module Plutarch.Lift (
+  -- * Converstion between Plutarch terms and Haskell types
+  pconstant,
+  plift,
+  plift',
+  LiftError,
+
+  -- * Define your own conversion
+  PConstant (..),
+  PLift,
+  DerivePConstantViaCoercible (..),
+  DerivePConstantViaNewtype (..),
+
+  -- * Internal use
+  PUnsafeLiftDecl (..),
+) where
 
 import Data.Coerce
 import Data.Kind (Type)
@@ -19,14 +34,31 @@ import qualified UntypedPlutusCore as UPLC
 class (PConstant (PLifted p), PConstanted (PLifted p) ~ p) => PUnsafeLiftDecl (p :: PType) where
   type PLifted p :: Type
 
+{- | Class of Haskell types `h` that can be represented as a Plutus core builtin
+and converted to a Plutarch type.
+
+The Plutarch type is determined by `PConstanted h`. Its Plutus Core representation is given by `PConstantRepr h`.
+
+This typeclass is closely tied with 'PLift'.
+-}
 class (PUnsafeLiftDecl (PConstanted h), PLC.DefaultUni `PLC.Includes` PConstantRepr h) => PConstant (h :: Type) where
   type PConstantRepr h :: Type
   type PConstanted h :: PType
   pconstantToRepr :: h -> PConstantRepr h
   pconstantFromRepr :: PConstantRepr h -> Maybe h
 
+{- | Class of Plutarch types `p` that can be converted to/from a Haskell type.
+
+The Haskell type is determined by `PLifted p`.
+
+This typeclass is closely tied with 'PConstant'.
+-}
 type PLift = PUnsafeLiftDecl
 
+{- | Create a Plutarch-level constant, from a Haskell value.
+Example:
+> pconstant @PInteger 42
+-}
 pconstant :: forall p s. PLift p => PLifted p -> Term s p
 pconstant x = punsafeConstantInternal $ PLC.someValue @(PConstantRepr (PLifted p)) @PLC.DefaultUni $ pconstantToRepr x
 
@@ -38,6 +70,9 @@ data LiftError
   | LiftError_WrongRepr
   deriving stock (Eq, Show)
 
+{- | Convert a Plutarch term to the associated Haskell value. Fail otherwise.
+This will fully evaluate the arbitrary closed expression, and convert the resulting value.
+-}
 plift' :: forall p. PUnsafeLiftDecl p => ClosedTerm p -> Either LiftError (PLifted p)
 plift' prog = case evaluateScript (compile prog) of
   Right (_, _, Scripts.unScript -> UPLC.Program _ _ term) ->
@@ -48,19 +83,25 @@ plift' prog = case evaluateScript (compile prog) of
       Left e -> Left $ LiftError_EvalException e
   Left e -> Left $ LiftError_ScriptError e
 
+-- | Like `plift'` but fails on error.
 plift :: forall p. (HasCallStack, PLift p) => ClosedTerm p -> (PLifted p)
 plift prog = case plift' prog of
   Right x -> x
   Left e -> error $ "plift failed: " <> show e
 
+-- TODO: Add haddock
 newtype DerivePConstantViaCoercible (h :: Type) (p :: PType) (r :: Type) = DerivePConstantViaCoercible h
 
-instance (PLift p, Coercible h r, PLC.DefaultUni `PLC.Includes` r) => PConstant (DerivePConstantViaCoercible h p r) where
+instance
+  (PLift p, Coercible h r, PLC.DefaultUni `PLC.Includes` r) =>
+  PConstant (DerivePConstantViaCoercible h p r)
+  where
   type PConstantRepr (DerivePConstantViaCoercible h p r) = r
   type PConstanted (DerivePConstantViaCoercible h p r) = p
   pconstantToRepr = coerce
   pconstantFromRepr = Just . coerce
 
+-- TODO: Add haddock
 newtype DerivePConstantViaNewtype (h :: Type) (p :: PType) (p' :: PType) = DerivePConstantViaNewtype h
 
 instance (PLift p, PLift p', Coercible h (PLifted p')) => PConstant (DerivePConstantViaNewtype h p p') where

Plutarch/Monadic.hs

@@ -6,11 +6,46 @@ import Data.String (fromString)
 import Plutarch.Prelude
 import Plutarch.Trace (ptraceError)
 
+{- | Bind function used within do syntax.
+
+Enables elegant usage of 'pmatch' and similar.
+
+@
+  import qualified Plutarch.Monadic as P
+
+  f :: Term s (PTxInfo :--> PBuiltinList (PAsData PTxInInfo))
+  f = plam $ \x -> P.do
+  PTxInfo txInfoFields <- pmatch x
+  pfromData $ pdhead # txInfoFields
+@
+-}
 (>>=) :: (x -> Term s a) -> x -> Term s a
 (>>=) = id
 
+{- | Forgetful bind function used within do syntax.
+
+Enables elegant usage of 'ptrace' and similar.
+
+@
+  import qualified Plutarch.Monadic as P
+
+  P.do
+    ptrace "yielding unit"
+    pconstant ()
+@
+-}
 (>>) :: (x -> Term s a) -> x -> Term s a
 (>>) = id
 
+{- | Implicitly invoked upon pattern match failure within do syntax.
+
+@
+  import qualified Plutarch.Monadic as P
+
+  P.do
+    -- calls 'P.fail', traces an error message, and invokes 'perror'.
+    PTrue <- pconstant False
+@
+-}
 fail :: String -> Term s a
 fail msg = ptraceError (fromString msg)

Plutarch/Rec.hs

@@ -60,7 +60,11 @@ pletrec :: forall r s. (Rank2.Distributive r, Rank2.Traversable r) => (r (Term s
 pletrec = punsafeCoerce . letrec
 
 -- | Recursive let construct, tying into knot the recursive equations specified in the record fields.
-letrec :: forall r s t. (Rank2.Distributive r, Rank2.Traversable r) => (r (Term s) -> r (Term s)) -> Term s (ScottEncoding r t)
+letrec ::
+  forall r s t.
+  (Rank2.Distributive r, Rank2.Traversable r) =>
+  (r (Term s) -> r (Term s)) ->
+  Term s (ScottEncoding r t)
 letrec r = Term term
   where
     term n = TermResult {getTerm = RApply rfix [RLamAbs 1 $ RApply (RVar 0) $ rawTerms], getDeps = deps}
@@ -188,4 +192,8 @@ fieldCount = getSum . Rank2.foldMap (const $ Sum 1)
 rfix :: RawTerm
 -- The simplest variant of the Y combinator hangs the interpreter, so we use an eta-expanded version instead.
 -- rfix = RLamAbs 0 $ RApply (RLamAbs 0 $ RApply (RVar 1) [RApply (RVar 0) [RVar 0]]) [RLamAbs 0 $ RApply (RVar 1) [RApply (RVar 0) [RVar 0]]]
-rfix = RLamAbs 0 $ RApply (RLamAbs 0 $ RApply (RVar 1) [RLamAbs 0 $ RApply (RVar 1) [RVar 0, RVar 1]]) [RLamAbs 0 $ RApply (RVar 1) [RLamAbs 0 $ RApply (RVar 1) [RVar 0, RVar 1]]]
+rfix =
+  RLamAbs 0 $
+    RApply
+      (RLamAbs 0 $ RApply (RVar 1) [RLamAbs 0 $ RApply (RVar 1) [RVar 0, RVar 1]])
+      [RLamAbs 0 $ RApply (RVar 1) [RLamAbs 0 $ RApply (RVar 1) [RVar 0, RVar 1]]]

Plutarch/String.hs

@@ -9,7 +9,13 @@ import qualified Data.Text as Txt
 import Plutarch (punsafeBuiltin)
 import Plutarch.Bool (PEq, (#==))
 import Plutarch.ByteString (PByteString)
-import Plutarch.Lift (DerivePConstantViaCoercible (DerivePConstantViaCoercible), PConstant, PLifted, PUnsafeLiftDecl, pconstant)
+import Plutarch.Lift (
+  DerivePConstantViaCoercible (DerivePConstantViaCoercible),
+  PConstant,
+  PLifted,
+  PUnsafeLiftDecl,
+  pconstant,
+ )
 import Plutarch.Prelude
 import qualified PlutusCore as PLC
 

Plutarch/Unit.hs

@@ -5,7 +5,13 @@ module Plutarch.Unit (PUnit (..)) where
 
 import Plutarch (PlutusType (PInner, pcon', pmatch'), Term, pcon)
 import Plutarch.Bool (PBool (PFalse, PTrue), PEq, POrd, (#<), (#<=), (#==))
-import Plutarch.Lift (DerivePConstantViaCoercible (DerivePConstantViaCoercible), PConstant, PLifted, PUnsafeLiftDecl, pconstant)
+import Plutarch.Lift (
+  DerivePConstantViaCoercible (DerivePConstantViaCoercible),
+  PConstant,
+  PLifted,
+  PUnsafeLiftDecl,
+  pconstant,
+ )
 
 data PUnit s = PUnit
 instance PUnsafeLiftDecl PUnit where type PLifted PUnit = ()