Skip to content

Commit

Permalink
Pretty-printing with indexes by default, simple representation by
Browse files Browse the repository at this point in the history
opt-in.
  • Loading branch information
Unisay committed Jul 8, 2024
1 parent c2dfbe6 commit 32b2a52
Show file tree
Hide file tree
Showing 71 changed files with 841 additions and 825 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ import Cardano.Constitution.Validator.TestsCommon
import Helpers.TestBuilders
import PlutusCore.Evaluation.Machine.ExBudget
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
import PlutusCore.Pretty (prettyPlcReadableDef)
import PlutusCore.Pretty (prettyPlcReadable)
import PlutusLedgerApi.V3 as V3
import PlutusLedgerApi.V3.ArbitraryContexts as V3
import PlutusTx.Code as Tx
Expand Down Expand Up @@ -56,13 +56,13 @@ test_budget_small = testGroup "BudgetSmall" $ M.elems $
test_readable_pir = testGroup "ReadablePir" $ M.elems $
(\vName (_, vCode) ->
goldenVsString vName (mkPath vName ["pir"]) $
pure $ fromString $ show $ prettyPlcReadableDef $ fromJust $ getPirNoAnn vCode
pure $ fromString $ show $ prettyPlcReadable $ fromJust $ getPirNoAnn vCode
)`M.mapWithKey` defaultValidatorsWithCodes

test_readable_uplc = testGroup "ReadableUplc" $ M.elems $
(\vName (_, vCode) ->
goldenVsString vName (mkPath vName ["uplc"]) $
pure $ fromString $ show $ prettyPlcReadableDef $ getPlcNoAnn vCode
pure $ fromString $ show $ prettyPlcReadable $ getPlcNoAnn vCode
)`M.mapWithKey` defaultValidatorsWithCodes

tests :: TestTreeWithTestState
Expand Down
2 changes: 1 addition & 1 deletion plutus-benchmark/cek-calibration/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,7 @@ writePlc p =
traverseOf UPLC.progTerm UPLC.unDeBruijnTerm p
of
Left e -> throw e
Right p' -> Haskell.print . PP.prettyPlcClassicDebug $ p'
Right p' -> Haskell.print . PP.prettyPlcClassicSimple $ p'


main1 :: Haskell.IO ()
Expand Down
6 changes: 3 additions & 3 deletions plutus-benchmark/nofib/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ import PlutusCore.Default (DefaultFun, DefaultUni)
import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..))
import PlutusCore.Pretty (prettyPlcClassicDebug)
import PlutusCore.Pretty (prettyPlcClassicSimple)
import PlutusTx (getPlcNoAnn)
import PlutusTx.Code (CompiledCode, sizePlc)
import PlutusTx.Prelude hiding (fmap, mappend, traverse_, (<$), (<$>), (<*>), (<>))
Expand Down Expand Up @@ -311,7 +311,7 @@ main :: IO ()
main = do
execParser (info (helper <*> options) (fullDesc <> progDesc description <> footerDoc (Just footerInfo))) >>= \case
RunPLC pa ->
print . prettyPlcClassicDebug . evaluateWithCek . getTerm $ pa
print . prettyPlcClassicSimple . evaluateWithCek . getTerm $ pa
RunHaskell pa ->
case pa of
Clausify formula -> print $ Clausify.runClausify formula
Expand All @@ -322,7 +322,7 @@ main = do
Primetest n -> if n<0 then Hs.error "Positive number expected"
else print $ Prime.runPrimalityTest n
DumpPLC pa ->
traverse_ putStrLn $ unindent . prettyPlcClassicDebug . UPLC.Program () PLC.latestVersion . getTerm $ pa
traverse_ putStrLn $ unindent . prettyPlcClassicSimple . UPLC.Program () PLC.latestVersion . getTerm $ pa
where unindent d = map (dropWhile isSpace) $ (Hs.lines . Hs.show $ d)
DumpFlatNamed pa ->
writeFlatNamed . UPLC.Program () PLC.latestVersion . getTerm $ pa
Expand Down
2 changes: 1 addition & 1 deletion plutus-benchmark/nofib/test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@ runTestGhc = runTestNested ["nofib", "test"] . pure . testNestedGhc
-- Unit tests comparing PLC and Haskell computations on given inputs

runAndCheck :: Tx.Lift DefaultUni a => Term -> a -> IO ()
runAndCheck term value = cekResultMatchesHaskellValue term (@?=) value
runAndCheck term = cekResultMatchesHaskellValue term (@?=)

---------------- Clausify ----------------

Expand Down
2 changes: 1 addition & 1 deletion plutus-benchmark/script-contexts/test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ assertSucceeded t =
case runTermCek t of
(Right _, _) -> pure ()
(Left err, logs) -> assertFailure . Text.unpack . Text.intercalate "\n" $
[ render (prettyPlcClassicDebug err)
[ render (prettyPlcClassicSimple err)
, "Cek logs:"
] ++ logs

Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
### Changed

- All names are printed with their unique suffixes by default.
4 changes: 2 additions & 2 deletions plutus-core/executables/plc/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -168,9 +168,9 @@ runTypecheck (TypecheckOptions inp fmt) = do
PLC.inferTypeOfProgram tcConfig (void prog)
of
Left (e :: PLC.Error PLC.DefaultUni PLC.DefaultFun ()) ->
errorWithoutStackTrace $ PP.displayPlcDef e
errorWithoutStackTrace $ PP.displayPlc e
Right ty ->
T.putStrLn (PP.displayPlcDef ty) >> exitSuccess
T.putStrLn (PP.displayPlc ty) >> exitSuccess

---------------- Optimisation ----------------

Expand Down
8 changes: 4 additions & 4 deletions plutus-core/executables/plutus/AnyProgram/IO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -90,10 +90,10 @@ writeProgram sng ast file =

prettyWithStyle :: PP.PrettyPlc a => PrettyStyle -> a -> Doc ann
prettyWithStyle = \case
Classic -> PP.prettyPlcClassicDef
ClassicDebug -> PP.prettyPlcClassicDebug
Readable -> PP.prettyPlcReadableDef
ReadableDebug -> PP.prettyPlcReadableDebug
Classic -> PP.prettyPlcClassic
ClassicSimple -> PP.prettyPlcClassicSimple
Readable -> PP.prettyPlcReadable
ReadableSimple -> PP.prettyPlcReadableSimple

readFileName :: (?opts :: Opts)
=> FileName -> IO BS.ByteString
Expand Down
6 changes: 3 additions & 3 deletions plutus-core/executables/plutus/Debugger/TUI/Event.hs
Original file line number Diff line number Diff line change
Expand Up @@ -148,13 +148,13 @@ handleDebuggerEvent _ hsDir (B.AppEvent (UpdateClientEvent budgetData cekState))
BE.editorText
EditorReturnValue
Nothing
(PLC.displayPlcDef (dischargeCekValue v))
(PLC.displayPlc (dischargeCekValue v))
Terminating t ->
dsReturnValueEditor .~
BE.editorText
EditorReturnValue
Nothing
(PLC.render $ vcat ["Evaluation Finished. Result:", line, PLC.prettyPlcDef t])
(PLC.render $ vcat ["Evaluation Finished. Result:", line, PLC.prettyPlc t])
Starting{} -> id
handleDebuggerEvent _ _ (B.AppEvent (CekErrorEvent budgetData e)) =
modify' $ \st ->
Expand All @@ -163,7 +163,7 @@ handleDebuggerEvent _ _ (B.AppEvent (CekErrorEvent budgetData e)) =
-- on the chain: the difference is that on the chain, a budget may become zero (exhausted)
-- but is not allowed to become negative.
st & set dsBudgetData budgetData
& appendToLogsEditor ("Error happened:" <+> PLC.prettyPlcDef e)
& appendToLogsEditor ("Error happened:" <+> PLC.prettyPlc e)
handleDebuggerEvent _ _ (B.AppEvent (DriverLogEvent t)) =
modify' $ appendToLogsEditor ("Driver logged:" <+> pretty t)
handleDebuggerEvent _ _ (B.AppEvent (CekEmitEvent t)) =
Expand Down
4 changes: 2 additions & 2 deletions plutus-core/executables/plutus/Debugger/TUI/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -88,7 +88,7 @@ main sn sa prog = do
STxSrcSpans -> progN

-- make sure to not display annotations
let progTextN = withA @PP.Pretty sa $ PP.displayPlcDef $ void progN
let progTextN = withA @PP.Pretty sa $ PP.displayPlc $ void progN

-- the parsed prog with uplc.srcspan
progWithUplcSpan <- either (fail . show @(PLC.Error DefaultUni DefaultFun PLC.SrcSpan)) pure $
Expand Down Expand Up @@ -168,7 +168,7 @@ driverThread driverMailbox brickMailbox prog mbudget = do
let term = prog ^. UPLC.progTerm
ndterm <- case runExcept @FreeVariableError $ deBruijnTerm term of
Right t -> pure t
Left _ -> fail $ "deBruijnTerm failed: " <> PLC.displayPlcDef (void term)
Left _ -> fail $ "deBruijnTerm failed: " <> PLC.displayPlc (void term)
-- if user provided `--budget` the mode is restricting; otherwise just counting
-- See Note [Budgeting implementation for the debugger]
let exBudgetMode = case mbudget of
Expand Down
10 changes: 5 additions & 5 deletions plutus-core/executables/plutus/GetOpt.hs
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,7 @@ optDescrs =

-- PRETTY-STYLE for OUTPUT & ERRORS
, Option ['p'] ["pretty"]
(ReqArg (set prettyStyle . read) "STYLE") "Make program's textual-output&error output pretty. Ignored for non-textual output (flat/cbor). Values: `classic`, `readable, `classic-debug`, `readable-debug` "
(ReqArg (set prettyStyle . read) "STYLE") "Make program's textual-output&error output pretty. Ignored for non-textual output (flat/cbor). Values: `classic`, `readable, `classic-simple`, `readable-simple` "
-- OUTPUT
, Option ['o'] []
(ReqArg (setOutput . AbsolutePath) "FILE") "Write compiled program to file"
Expand Down Expand Up @@ -257,14 +257,14 @@ instance Read Ann where
instance Read PrettyStyle where
readsPrec _prec = one . \case
"classic" -> Classic
"classic-debug" -> ClassicDebug
"classic-simple" -> ClassicSimple
"readable" -> Readable
"readable-debug" -> ReadableDebug
"readable-simple" -> ReadableSimple
-- synonyms for lazy people like me
"c" -> Classic
"cd" -> ClassicDebug
"cs" -> ClassicSimple
"r" -> Readable
"rd" -> ReadableDebug
"rs" -> ReadableSimple
_ -> error "Failed to read --pretty=STYLE."

instance Read ExBudget where
Expand Down
4 changes: 2 additions & 2 deletions plutus-core/executables/plutus/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -109,9 +109,9 @@ data DebugInterface
-- | ONLY applicable for Text output.
data PrettyStyle
= Classic
| ClassicDebug
| ClassicSimple
| Readable
| ReadableDebug
| ReadableSimple
deriving stock (Show)

data Verbosity
Expand Down
24 changes: 12 additions & 12 deletions plutus-core/executables/src/PlutusCore/Executable/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -180,7 +180,7 @@ printBudgetStateTally term model (Cek.CekExTally costs) = do
putStrLn ""
putStrLn $ "Total builtin costs: " ++ budgetToString totalBuiltinCosts
printf "Time spent executing builtins: %4.2f%%\n"
(100 * (getCPU totalBuiltinCosts) / (getCPU totalCost))
(100 * getCPU totalBuiltinCosts / getCPU totalCost)
putStrLn ""
putStrLn $ "Total budget spent: " ++ printf (budgetToString totalCost)
putStrLn $ "Predicted execution time: "
Expand Down Expand Up @@ -316,7 +316,7 @@ writeFlat ::
writeFlat outp flatMode prog = do
-- ASTs are always serialised with unit annotations to save space: `flat`
-- does not need any space to serialise ().
let flatProg = serialiseProgramFlat flatMode (() <$ prog)
let flatProg = serialiseProgramFlat flatMode (void prog)
case outp of
FileOutput file -> BSL.writeFile file flatProg
StdOutput -> BSL.putStr flatProg
Expand All @@ -327,10 +327,10 @@ writeFlat outp flatMode prog = do
getPrintMethod ::
PP.PrettyPlc a => PrintMode -> (a -> Doc ann)
getPrintMethod = \case
Classic -> PP.prettyPlcClassicDef
Debug -> PP.prettyPlcClassicDebug
Readable -> PP.prettyPlcReadableDef
ReadableDebug -> PP.prettyPlcReadableDebug
Classic -> PP.prettyPlcClassic
Simple -> PP.prettyPlcClassicSimple
Readable -> PP.prettyPlcReadable
ReadableSimple -> PP.prettyPlcReadableSimple

writeProgram ::
( ProgramLike p
Expand Down Expand Up @@ -380,20 +380,20 @@ data SomeExample = SomeTypedExample SomeTypedExample | SomeUntypedExample SomeUn

prettySignature :: ExampleName -> SomeExample -> Doc ann
prettySignature name (SomeTypedExample (SomeTypeExample (TypeExample kind _))) =
pretty name <+> "::" <+> PP.prettyPlcDef kind
pretty name <+> "::" <+> PP.prettyPlc kind
prettySignature name (SomeTypedExample (SomeTypedTermExample (TypedTermExample ty _))) =
pretty name <+> ":" <+> PP.prettyPlcDef ty
pretty name <+> ":" <+> PP.prettyPlc ty
prettySignature name (SomeUntypedExample _) =
pretty name

prettyExample :: SomeExample -> Doc ann
prettyExample =
\case
SomeTypedExample (SomeTypeExample (TypeExample _ ty)) -> PP.prettyPlcDef ty
SomeTypedExample (SomeTypeExample (TypeExample _ ty)) -> PP.prettyPlc ty
SomeTypedExample (SomeTypedTermExample (TypedTermExample _ term)) ->
PP.prettyPlcDef $ PLC.Program () PLC.latestVersion term
PP.prettyPlc $ PLC.Program () PLC.latestVersion term
SomeUntypedExample (SomeUntypedTermExample (UntypedTermExample term)) ->
PP.prettyPlcDef $ UPLC.Program () PLC.latestVersion term
PP.prettyPlc $ UPLC.Program () PLC.latestVersion term

toTypedTermExample ::
PLC.Term PLC.TyName PLC.Name PLC.DefaultUni PLC.DefaultFun () -> TypedTermExample
Expand All @@ -405,7 +405,7 @@ toTypedTermExample term = TypedTermExample ty term
PLC.inferTypeOfProgram tcConfig program
ty = case errOrTy of
Left (err :: PLC.Error PLC.DefaultUni PLC.DefaultFun ()) ->
error $ PP.displayPlcDef err
error $ PP.displayPlc err
Right vTy -> PLC.unNormalized vTy

getInteresting :: IO [(ExampleName, PLC.Term PLC.TyName PLC.Name PLC.DefaultUni PLC.DefaultFun ())]
Expand Down
4 changes: 2 additions & 2 deletions plutus-core/executables/src/PlutusCore/Executable/Parsers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -100,12 +100,12 @@ printmode :: Parser PrintMode
printmode = option auto
( long "print-mode"
<> metavar "MODE"
<> value Debug
<> value Simple
<> showDefault
<> help
("Print mode for textual output (ignored elsewhere): Classic -> plcPrettyClassicDef, "
<> "Debug -> plcPrettyClassicDebug, "
<> "Readable -> prettyPlcReadableDef, ReadableDebug -> prettyPlcReadableDebug" ))
<> "Readable -> prettyPlcReadable, ReadableSimple -> prettyPlcReadableSimple" ))

printOpts :: Parser PrintOptions
printOpts = PrintOptions <$> input <*> output <*> printmode
Expand Down
2 changes: 1 addition & 1 deletion plutus-core/executables/src/PlutusCore/Executable/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@ instance Show Input where
data Output = FileOutput FilePath | StdOutput | NoOutput
data TimingMode = NoTiming | Timing Integer deriving stock (Eq) -- Report program execution time?
data CekModel = Default | Unit -- Which cost model should we use for CEK machine steps?
data PrintMode = Classic | Debug | Readable | ReadableDebug deriving stock (Show, Read)
data PrintMode = Classic | Simple | Readable | ReadableSimple deriving stock (Show, Read)
data TraceMode = None | Logs | LogsWithTimestamps | LogsWithBudgets deriving stock (Show, Read)
type ExampleName = T.Text
data ExampleMode = ExampleSingle ExampleName | ExampleAvailable
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -20,17 +20,17 @@ import PlutusCore.Pretty.PrettyConst
import Universe

instance Pretty TyName where
pretty = prettyClassicDef
pretty = prettyClassic

instance Pretty Name where
pretty = prettyClassicDef
pretty = prettyClassic

instance Pretty ann => Pretty (Kind ann) where
pretty = prettyClassicDef
pretty = prettyClassic

instance (PrettyClassic tyname, PrettyParens (SomeTypeIn uni), Pretty ann) =>
Pretty (Type tyname uni ann) where
pretty = prettyClassicDef
pretty = prettyClassic

instance
( PrettyClassic tyname
Expand All @@ -39,7 +39,7 @@ instance
, Pretty fun
, Pretty ann
) => Pretty (Term tyname name uni fun ann) where
pretty = prettyClassicDef
pretty = prettyClassic

instance
( PrettyClassic tyname
Expand All @@ -48,4 +48,4 @@ instance
, Pretty fun
, Pretty ann
) => Pretty (Program tyname name uni fun ann) where
pretty = prettyClassicDef
pretty = prettyClassic
Loading

0 comments on commit 32b2a52

Please sign in to comment.