All names are printed with their unique values by default. (Intersect…

…MBO#5972) * chore: explicit imports * Test demonstrates that without printed unique value a name won't roundtrip printing/parsing * Pretty-printing with indexes by default, simple representation by opt-in. * Updated golden files
mlabs-haskell · Jul 12, 2024 · 0c02489 · 0c02489
1 parent 19f192d
commit 0c02489
Show file tree

Hide file tree

Showing 633 changed files with 25,148 additions and 35,397 deletions.
diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs
@@ -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
@@ -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

diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden
diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden
diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden
diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden
diff --git a/plutus-benchmark/cek-calibration/Main.hs b/plutus-benchmark/cek-calibration/Main.hs
@@ -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 ()

diff --git a/plutus-benchmark/nofib/exe/Main.hs b/plutus-benchmark/nofib/exe/Main.hs
@@ -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_, (<$), (<$>), (<*>), (<>))
@@ -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
@@ -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

diff --git a/plutus-benchmark/nofib/test/Spec.hs b/plutus-benchmark/nofib/test/Spec.hs
@@ -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 ----------------
 

diff --git a/plutus-benchmark/script-contexts/test/Spec.hs b/plutus-benchmark/script-contexts/test/Spec.hs
@@ -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
 

diff --git a/...changelog.d/20240510_200705_Yuriy.Lazaryev_4808_unique_names_roundtrip_tests.md b/...changelog.d/20240510_200705_Yuriy.Lazaryev_4808_unique_names_roundtrip_tests.md
@@ -0,0 +1,3 @@
+### Changed
+
+-  All names are printed with their unique suffixes by default.
diff --git a/plutus-core/executables/plc/Main.hs b/plutus-core/executables/plc/Main.hs
@@ -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 ----------------
 

diff --git a/plutus-core/executables/plutus/AnyProgram/IO.hs b/plutus-core/executables/plutus/AnyProgram/IO.hs
@@ -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

diff --git a/plutus-core/executables/plutus/Debugger/TUI/Event.hs b/plutus-core/executables/plutus/Debugger/TUI/Event.hs
@@ -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 ->
@@ -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)) =

diff --git a/plutus-core/executables/plutus/Debugger/TUI/Main.hs b/plutus-core/executables/plutus/Debugger/TUI/Main.hs
@@ -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 $
@@ -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

diff --git a/plutus-core/executables/plutus/GetOpt.hs b/plutus-core/executables/plutus/GetOpt.hs
@@ -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"
@@ -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

diff --git a/plutus-core/executables/plutus/Types.hs b/plutus-core/executables/plutus/Types.hs
@@ -109,9 +109,9 @@ data DebugInterface
 -- | ONLY applicable for Text output.
 data PrettyStyle
     = Classic
-    | ClassicDebug
+    | ClassicSimple
     | Readable
-    | ReadableDebug
+    | ReadableSimple
     deriving stock (Show)
 
 data Verbosity

diff --git a/plutus-core/executables/src/PlutusCore/Executable/Common.hs b/plutus-core/executables/src/PlutusCore/Executable/Common.hs
@@ -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: "
@@ -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
@@ -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
@@ -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
@@ -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 ())]

diff --git a/plutus-core/executables/src/PlutusCore/Executable/Parsers.hs b/plutus-core/executables/src/PlutusCore/Executable/Parsers.hs
@@ -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

diff --git a/plutus-core/executables/src/PlutusCore/Executable/Types.hs b/plutus-core/executables/src/PlutusCore/Executable/Types.hs
@@ -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

diff --git a/plutus-core/plutus-core/src/PlutusCore/Core/Instance/Pretty/Default.hs b/plutus-core/plutus-core/src/PlutusCore/Core/Instance/Pretty/Default.hs
@@ -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
@@ -39,7 +39,7 @@ instance
         , Pretty fun
         , Pretty ann
         ) => Pretty (Term tyname name uni fun ann) where
-    pretty = prettyClassicDef
+    pretty = prettyClassic
 
 instance
         ( PrettyClassic tyname
@@ -48,4 +48,4 @@ instance
         , Pretty fun
         , Pretty ann
         ) => Pretty (Program tyname name uni fun ann) where
-    pretty = prettyClassicDef
+    pretty = prettyClassic