Skip to content

Commit

Permalink
Remove CBOR instances
Browse files Browse the repository at this point in the history
  • Loading branch information
Radu Ometita committed Nov 19, 2020
1 parent 5ac9686 commit a84a5fb
Show file tree
Hide file tree
Showing 15 changed files with 207 additions and 180 deletions.
41 changes: 21 additions & 20 deletions plutus-benchmark/nofib/exe/Main.hs
View file
Expand Up @@ -5,10 +5,11 @@ module Main where
import Prelude ((<>))
import qualified Prelude as P

-- import Codec.Serialise
import Control.Monad
import Control.Monad ()
import Control.Monad.Trans.Except (runExceptT)
import qualified Data.ByteString.Lazy as BSL
-- import qualified Data.ByteString.Lazy as BSL
import Data.Char (isSpace)
import Options.Applicative as Opt hiding (action)
import System.Exit (exitFailure)
Expand All @@ -18,7 +19,7 @@ import Text.PrettyPrint.ANSI.Leijen (Doc, indent,
import Language.PlutusCore (Name (..))
import qualified Language.PlutusCore as PLC
import Language.PlutusCore.Builtins
import Language.PlutusCore.CBOR ()
--import Language.PlutusCore.CBOR ()
import Language.PlutusCore.Evaluation.Machine.Cek ()
import qualified Language.PlutusCore.Pretty as PLC
import Language.PlutusCore.Universe
Expand Down Expand Up @@ -51,8 +52,8 @@ data Options
= RunPLC ProgAndArgs
| RunHaskell ProgAndArgs
| DumpPLC ProgAndArgs
| DumpCBORnamed ProgAndArgs
| DumpCBORdeBruijn ProgAndArgs
-- | DumpCBORnamed ProgAndArgs
-- | DumpCBORdeBruijn ProgAndArgs


-- Clausify options --
Expand Down Expand Up @@ -171,15 +172,15 @@ options = hsubparser
<> command "dumpPLC"
(info (DumpPLC <$> progAndArgs)
(progDesc "print the program (applied to arguments) as Plutus Core source on standard output"))
<> command "dumpCBORnamed"
(info (DumpCBORnamed <$> progAndArgs)
(progDesc "dump the AST as CBOR, preserving names"))
<> command "dumpCBOR"
(info (DumpCBORdeBruijn <$> progAndArgs)
(progDesc "same as dumpCBORdeBruijn, but easier to type"))
<> command "dumpCBORdeBruijn"
(info (DumpCBORdeBruijn <$> progAndArgs)
(progDesc "dump the AST as CBOR, with names replaced by de Bruijn indices"))
-- <> command "dumpCBORnamed"
-- (info (DumpCBORnamed <$> progAndArgs)
-- (progDesc "dump the AST as CBOR, preserving names"))
-- <> command "dumpCBOR"
-- (info (DumpCBORdeBruijn <$> progAndArgs)
-- (progDesc "same as dumpCBORdeBruijn, but easier to type"))
-- <> command "dumpCBORdeBruijn"
-- (info (DumpCBORdeBruijn <$> progAndArgs)
-- (progDesc "dump the AST as CBOR, with names replaced by de Bruijn indices"))
)


Expand All @@ -197,11 +198,11 @@ toDeBruijn prog = do

data CborMode = Named | DeBruijn

writeCBOR :: CborMode -> Program Name DefaultUni DefaultFun () -> IO ()
writeCBOR cborMode prog =
case cborMode of
Named -> BSL.putStr $ serialiseOmittingUnits prog
DeBruijn -> toDeBruijn prog >>= BSL.putStr . serialiseOmittingUnits
-- writeCBOR :: CborMode -> Program Name DefaultUni DefaultFun () -> IO ()
-- writeCBOR cborMode prog =
-- case cborMode of
-- Named -> BSL.putStr $ serialiseOmittingUnits prog
-- DeBruijn -> toDeBruijn prog >>= BSL.putStr . serialiseOmittingUnits

description :: String
description = "This program provides operations on a number of Plutus programs "
Expand Down Expand Up @@ -249,8 +250,8 @@ main = do
else print $ Prime.runPrimalityTest n
DumpPLC pa -> mapM_ putStrLn $ unindent . PLC.prettyPlcClassicDebug $ getWrappedProgram pa
where unindent d = map (dropWhile isSpace) $ (lines . show $ d)
DumpCBORnamed pa -> writeCBOR Named $ getWrappedProgram pa
DumpCBORdeBruijn pa-> writeCBOR DeBruijn $ getWrappedProgram pa
-- DumpCBORnamed pa -> writeCBOR Named $ getWrappedProgram pa
-- DumpCBORdeBruijn pa-> writeCBOR DeBruijn $ getWrappedProgram pa
-- ^ Write the output to stdout and let the user deal with redirecting it.
where getProgram =
\case
Expand Down
81 changes: 40 additions & 41 deletions plutus-core/exe/Main.hs
View file
Expand Up @@ -21,7 +21,7 @@ import qualified Language.UntypedPlutusCore as UPLC
import qualified Language.UntypedPlutusCore.DeBruijn as UPLC
import qualified Language.UntypedPlutusCore.Evaluation.Machine.Cek as UPLC

import Codec.Serialise
-- import Codec.Serialise
import Control.DeepSeq (rnf)
import qualified Control.Exception as Exn (evaluate)
import Control.Monad
Expand Down Expand Up @@ -91,11 +91,11 @@ data EvalMode = CK | CEK deriving (Show, Read)
data AstNameType = Named | DeBruijn -- Do we use Names or de Bruijn indices when (de)serialising ASTs?
type Files = [FilePath]

data Format = Plc | Cbor AstNameType | Flat AstNameType -- Input/output format for programs
data Format = Plc | {-Cbor AstNameType | -} Flat AstNameType -- Input/output format for programs
instance Show Format where
show Plc = "plc"
show (Cbor Named) = "cbor-named"
show (Cbor DeBruijn) = "cbor-deBruijn"
-- show (Cbor Named) = "cbor-named"
-- show (Cbor DeBruijn) = "cbor-deBruijn"
show (Flat Named) = "flat-named"
show (Flat DeBruijn) = "flat-deBruijn"

Expand Down Expand Up @@ -168,9 +168,9 @@ formatReader :: String -> Maybe Format
formatReader =
\case
"plc" -> Just Plc
"cbor-named" -> Just (Cbor Named)
"cbor" -> Just (Cbor DeBruijn)
"cbor-deBruijn" -> Just (Cbor DeBruijn)
-- "cbor-named" -> Just (Cbor Named)
-- "cbor" -> Just (Cbor DeBruijn)
-- "cbor-deBruijn" -> Just (Cbor DeBruijn)
"flat-named" -> Just (Flat Named)
"flat" -> Just (Flat DeBruijn)
"flat-deBruijn" -> Just (Flat DeBruijn)
Expand Down Expand Up @@ -363,19 +363,19 @@ getBinaryInput (FileInput file) = BSL.readFile file

-- Read and deserialise a CBOR-encoded AST
-- There's no (un-)deBruijnifier for typed PLC, so we don't handle that case.
loadASTfromCBOR :: Language -> AstNameType -> Input -> IO (Program ())
loadASTfromCBOR language cborMode inp =
case (language, cborMode) of
(TypedPLC, Named) -> getBinaryInput inp <&> PLC.deserialiseRestoringUnitsOrFail >>= handleResult TypedProgram
(UntypedPLC, Named) -> getBinaryInput inp <&> UPLC.deserialiseRestoringUnitsOrFail >>= handleResult UntypedProgram
(TypedPLC, DeBruijn) -> typedDeBruijnNotSupportedError
(UntypedPLC, DeBruijn) -> getBinaryInput inp <&> UPLC.deserialiseRestoringUnitsOrFail >>=
mapM fromDeBruijn >>= handleResult UntypedProgram
where handleResult wrapper =
\case
Left (DeserialiseFailure offset msg) ->
hPutStrLn stderr ("CBOR deserialisation failure at offset " ++ Prelude.show offset ++ ": " ++ msg) >> exitFailure
Right r -> return $ wrapper r
-- loadASTfromCBOR :: Language -> AstNameType -> Input -> IO (Program ())
-- loadASTfromCBOR language cborMode inp =
-- case (language, cborMode) of
-- (TypedPLC, Named) -> getBinaryInput inp <&> PLC.deserialiseRestoringUnitsOrFail >>= handleResult TypedProgram
-- (UntypedPLC, Named) -> getBinaryInput inp <&> UPLC.deserialiseRestoringUnitsOrFail >>= handleResult UntypedProgram
-- (TypedPLC, DeBruijn) -> typedDeBruijnNotSupportedError
-- (UntypedPLC, DeBruijn) -> getBinaryInput inp <&> UPLC.deserialiseRestoringUnitsOrFail >>=
-- mapM fromDeBruijn >>= handleResult UntypedProgram
-- where handleResult wrapper =
-- \case
-- Left (DeserialiseFailure offset msg) ->
-- hPutStrLn stderr ("CBOR deserialisation failure at offset " ++ Prelude.show offset ++ ": " ++ msg) >> exitFailure
-- Right r -> return $ wrapper r

-- Read and deserialise a Flat-encoded AST
loadASTfromFlat :: Language -> AstNameType -> Input -> IO (Program ())
Expand All @@ -396,34 +396,33 @@ getProgram :: Language -> Format -> Input -> IO (Program PLC.AlexPosn)
getProgram language fmt inp =
case fmt of
Plc -> parsePlcInput language inp
Cbor cborMode -> do
prog <- loadASTfromCBOR language cborMode inp
return $ PLC.AlexPn 0 0 0 <$ prog -- No source locations in CBOR, so we have to make them up.
-- Cbor cborMode -> do
-- prog <- loadASTfromCBOR language cborMode inp
-- return $ PLC.AlexPn 0 0 0 <$ prog -- No source locations in CBOR, so we have to make them up.
Flat flatMode -> do
prog <- loadASTfromFlat language flatMode inp
return $ PLC.AlexPn 0 0 0 <$ prog -- No source locations in CBOR, so we have to make them up.


---------------- Serialise a program using CBOR ----------------

serialiseProgramCBOR :: Program () -> BSL.ByteString
serialiseProgramCBOR (TypedProgram p) = PLC.serialiseOmittingUnits p
serialiseProgramCBOR (UntypedProgram p) = UPLC.serialiseOmittingUnits p
-- serialiseProgramCBOR :: Program () -> BSL.ByteString
-- serialiseProgramCBOR (TypedProgram p) = PLC.serialiseOmittingUnits p
-- serialiseProgramCBOR (UntypedProgram p) = UPLC.serialiseOmittingUnits p

-- | Convert names to de Bruijn indices and then serialise
serialiseDbProgramCBOR :: Program () -> IO (BSL.ByteString)
serialiseDbProgramCBOR (TypedProgram _) = typedDeBruijnNotSupportedError
serialiseDbProgramCBOR (UntypedProgram p) = UPLC.serialiseOmittingUnits <$> toDeBruijn p

writeCBOR :: Output -> AstNameType -> Program a -> IO ()
writeCBOR outp cborMode prog = do
cbor <- case cborMode of
Named -> pure $ serialiseProgramCBOR (() <$ prog) -- Change annotations to (): see Note [Annotation types].
DeBruijn -> serialiseDbProgramCBOR (() <$ prog)
case outp of
FileOutput file -> BSL.writeFile file cbor
StdOutput -> BSL.putStr cbor >> T.putStrLn ""
-- -- | Convert names to de Bruijn indices and then serialise
-- serialiseDbProgramCBOR :: Program () -> IO (BSL.ByteString)
-- serialiseDbProgramCBOR (TypedProgram _) = typedDeBruijnNotSupportedError
-- serialiseDbProgramCBOR (UntypedProgram p) = UPLC.serialiseOmittingUnits <$> toDeBruijn p

-- writeCBOR :: Output -> AstNameType -> Program a -> IO ()
-- writeCBOR outp cborMode prog = do
-- cbor <- case cborMode of
-- Named -> pure $ serialiseProgramCBOR (() <$ prog) -- Change annotations to (): see Note [Annotation types].
-- DeBruijn -> serialiseDbProgramCBOR (() <$ prog)
-- case outp of
-- FileOutput file -> BSL.writeFile file cbor
-- StdOutput -> BSL.putStr cbor >> T.putStrLn ""

---------------- Serialise a program using Flat ----------------

Expand Down Expand Up @@ -464,7 +463,7 @@ writePlc outp mode prog = do

writeProgram :: Output -> Format -> PrintMode -> Program a -> IO ()
writeProgram outp Plc mode prog = writePlc outp mode prog
writeProgram outp (Cbor cborMode) _ prog = writeCBOR outp cborMode prog
-- writeProgram outp (Cbor cborMode) _ prog = writeCBOR outp cborMode prog
writeProgram outp (Flat flatMode) _ prog = writeFlat outp flatMode prog


Expand Down Expand Up @@ -599,7 +598,7 @@ runErase (EraseOptions inp ifmt outp ofmt mode) = do
let untypedProg = () <$ (UntypedProgram $ UPLC.eraseProgram typedProg)
case ofmt of
Plc -> writePlc outp mode untypedProg
Cbor cborMode -> writeCBOR outp cborMode untypedProg
-- Cbor cborMode -> writeCBOR outp cborMode untypedProg
Flat flatMode -> writeFlat outp flatMode untypedProg


Expand Down
4 changes: 2 additions & 2 deletions plutus-core/plutus-core.cabal
View file
Expand Up @@ -57,7 +57,7 @@ library
Language.PlutusCore.Evaluation.Result
Language.PlutusCore.Check.Value
Language.PlutusCore.Check.Normal
Language.PlutusCore.CBOR
-- Language.PlutusCore.CBOR
Language.PlutusCore.Flat
Language.PlutusCore.Constant
Language.PlutusCore.Constant.Dynamic.Emit
Expand Down Expand Up @@ -199,7 +199,7 @@ library
Language.UntypedPlutusCore.Core.Instance.Pretty.Plc
Language.UntypedPlutusCore.Core.Instance.Pretty.Readable
Language.UntypedPlutusCore.Core.Instance.Recursive
Language.UntypedPlutusCore.Core.Instance.CBOR
-- Language.UntypedPlutusCore.Core.Instance.CBOR
Language.UntypedPlutusCore.Core.Instance.Flat
Language.UntypedPlutusCore.Core.Type
Language.UntypedPlutusCore.Core.Plated
Expand Down
57 changes: 30 additions & 27 deletions plutus-core/plutus-ir/Language/PlutusIR.hs
View file
Expand Up @@ -37,16 +37,17 @@ import PlutusPrelude

import Language.PlutusCore (Kind, Name, TyName, Type (..), typeSubtypes)
import qualified Language.PlutusCore as PLC
import Language.PlutusCore.CBOR ()
import Language.PlutusCore.Constant (AsConstant (..), FromConstant (..))
import Language.PlutusCore.Core (UniOf)
import Language.PlutusCore.Flat ()
import Language.PlutusCore.MkPlc (Def (..), TermLike (..), TyVarDecl (..), VarDecl (..))
import qualified Language.PlutusCore.Name as PLC
import qualified Language.PlutusCore.Pretty as PLC

import Control.Lens hiding (Strict)

import Codec.Serialise (Serialise)
-- import Codec.Serialise (Serialise)
import Flat (Flat)

import qualified Data.Text as T
import Data.Text.Prettyprint.Doc.Custom
Expand All @@ -66,11 +67,13 @@ data Datatype tyname name uni fun a = Datatype a (TyVarDecl tyname a) [TyVarDecl
deriving (Functor, Show, Generic)

instance ( PLC.Closed uni
, uni `PLC.Everywhere` Serialise
, Serialise a
, Serialise tyname
, Serialise name
) => Serialise (Datatype tyname name uni fun a)
, uni `PLC.Everywhere` Flat
, Flat a
, Flat tyname
, Flat name
-- This was needed only for the Flat instance
, Flat fun
) => Flat (Datatype tyname name uni fun a)

varDeclNameString :: VarDecl tyname Name uni fun a -> String
varDeclNameString = T.unpack . PLC.nameString . varDeclName
Expand All @@ -97,25 +100,25 @@ instance Semigroup Recursivity where
NonRec <> x = x
Rec <> _ = Rec

instance Serialise Recursivity
instance Flat Recursivity

data Strictness = NonStrict | Strict
deriving (Show, Eq, Generic)

instance Serialise Strictness
instance Flat Strictness

data Binding tyname name uni fun a = TermBind a Strictness (VarDecl tyname name uni fun a) (Term tyname name uni fun a)
| TypeBind a (TyVarDecl tyname a) (Type tyname uni a)
| DatatypeBind a (Datatype tyname name uni fun a)
deriving (Functor, Show, Generic)

instance ( PLC.Closed uni
, uni `PLC.Everywhere` Serialise
, Serialise fun
, Serialise a
, Serialise tyname
, Serialise name
) => Serialise (Binding tyname name uni fun a)
, uni `PLC.Everywhere` Flat
, Flat fun
, Flat a
, Flat tyname
, Flat name
) => Flat (Binding tyname name uni fun a)

{-# INLINE bindingSubterms #-}
-- | Get all the direct child 'Term's of the given 'Binding'.
Expand Down Expand Up @@ -216,12 +219,12 @@ instance FromConstant (Term tyname name uni fun ()) where
fromConstant value = Constant () value

instance ( PLC.Closed uni
, uni `PLC.Everywhere` Serialise
, Serialise fun
, Serialise a
, Serialise tyname
, Serialise name
) => Serialise (Term tyname name uni fun a)
, uni `PLC.Everywhere` Flat
, Flat fun
, Flat a
, Flat tyname
, Flat name
) => Flat (Term tyname name uni fun a)

instance TermLike (Term tyname name uni fun) tyname name uni fun where
var = Var
Expand Down Expand Up @@ -280,12 +283,12 @@ termBindings f = \case
data Program tyname name uni fun a = Program a (Term tyname name uni fun a) deriving Generic

instance ( PLC.Closed uni
, uni `PLC.Everywhere` Serialise
, Serialise fun
, Serialise a
, Serialise tyname
, Serialise name
) => Serialise (Program tyname name uni fun a)
, uni `PLC.Everywhere` Flat
, Flat fun
, Flat a
, Flat tyname
, Flat name
) => Flat (Program tyname name uni fun a)

-- Pretty-printing

Expand Down
2 changes: 1 addition & 1 deletion plutus-core/src/Language/PlutusCore.hs
View file
Expand Up @@ -107,7 +107,7 @@ module Language.PlutusCore
import PlutusPrelude

import Language.PlutusCore.Builtins
import Language.PlutusCore.CBOR ()
-- import Language.PlutusCore.CBOR ()
import qualified Language.PlutusCore.Check.Uniques as Uniques
import Language.PlutusCore.Core
import Language.PlutusCore.Error
Expand Down

0 comments on commit a84a5fb

Please sign in to comment.