From 96e0f335b7c1ceda0986011c3ee08b4b1ec823ac Mon Sep 17 00:00:00 2001 From: Yura Lazaryev Date: Wed, 8 May 2024 13:59:08 +0200 Subject: [PATCH 1/4] chore: explicit imports --- plutus-core/plutus-core/test/Names/Spec.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/plutus-core/plutus-core/test/Names/Spec.hs b/plutus-core/plutus-core/test/Names/Spec.hs index 44aa2a0730d..3d4b2e3cec4 100644 --- a/plutus-core/plutus-core/test/Names/Spec.hs +++ b/plutus-core/plutus-core/test/Names/Spec.hs @@ -177,6 +177,10 @@ test_rebindCapturedVariable = testCase "rebindCapturedVariable" do [typeL1, typeL2] @?= [typeR1, typeR2] +prop_printing_parsing_roundtrip :: TestTree +prop_printing_parsing_roundtrip = testCase "Print-parse roundtrip" do + tripping + test_names :: TestTree test_names = testGroup @@ -191,4 +195,5 @@ test_names = , test_alphaEquality , test_rebindShadowedVariable , test_rebindCapturedVariable + , prop_printing_parsing_roundtrip ] From 56408031e5205228ef78de201af48b07efeca770 Mon Sep 17 00:00:00 2001 From: Yura Lazaryev Date: Fri, 10 May 2024 18:38:41 +0200 Subject: [PATCH 2/4] Test demonstrates that without printed unique value a name won't roundtrip printing/parsing --- plutus-core/plutus-core/test/Names/Spec.hs | 31 +++++++++++++++++----- 1 file changed, 25 insertions(+), 6 deletions(-) diff --git a/plutus-core/plutus-core/test/Names/Spec.hs b/plutus-core/plutus-core/test/Names/Spec.hs index 3d4b2e3cec4..d275a048c41 100644 --- a/plutus-core/plutus-core/test/Names/Spec.hs +++ b/plutus-core/plutus-core/test/Names/Spec.hs @@ -7,16 +7,20 @@ module Names.Spec where import Data.String (IsString (fromString)) +import Data.Text qualified as Text import Hedgehog (Gen, Property, assert, forAll, property, tripping) import Hedgehog.Gen qualified as Gen import PlutusCore (DefaultFun, DefaultUni, FreeVariableError, Kind (Type), Name (..), NamedDeBruijn, NamedTyDeBruijn, Program, Quote, Rename (rename), Term (..), TyName (..), Type (..), Unique (..), deBruijnTerm, runQuote, runQuoteT, unDeBruijnTerm) +import PlutusCore qualified import PlutusCore.Generators.Hedgehog (TermOf (..), forAllNoShowT, forAllPretty, generalizeT) -import PlutusCore.Generators.Hedgehog.AST as AST (genProgram, genTerm, mangleNames, runAstGen) +import PlutusCore.Generators.Hedgehog.AST as AST (genName, genProgram, genTerm, mangleNames, + runAstGen) import PlutusCore.Generators.Hedgehog.Interesting (fromInterestingTermGens) import PlutusCore.Mark (markNonFreshProgram) -import PlutusCore.Pretty (displayPlcDebug) +import PlutusCore.Parser qualified as Parser +import PlutusCore.Pretty (displayPlcDebug, pretty, render) import PlutusCore.Rename.Internal (renameProgramM) import PlutusCore.Test (BindingRemoval (BindingRemovalNotOk), Prerename (PrerenameNo), brokenRename, checkFails, noMarkRename, test_scopingGood, test_scopingSpoilRenamer) @@ -177,9 +181,24 @@ test_rebindCapturedVariable = testCase "rebindCapturedVariable" do [typeL1, typeL2] @?= [typeR1, typeR2] -prop_printing_parsing_roundtrip :: TestTree -prop_printing_parsing_roundtrip = testCase "Print-parse roundtrip" do - tripping +test_printing_parsing_roundtrip :: TestTree +test_printing_parsing_roundtrip = + testPropertyNamed + "Printing/parsing roundtrip" + "name_print_parse_roundtrip" + prop_printing_parsing_roundtrip + +prop_printing_parsing_roundtrip :: Property +prop_printing_parsing_roundtrip = property $ generalizeT do + name <- forAllPretty $ runAstGen genName + tripping name printName parseName + where + printName :: Name -> String + printName = render . pretty + + parseName :: String -> Either (PlutusCore.Error DefaultUni DefaultFun ()) Name + parseName str = runQuoteT do + Parser.parse Parser.name "test_printing_parsing_roundtrip" (Text.pack str) test_names :: TestTree test_names = @@ -195,5 +214,5 @@ test_names = , test_alphaEquality , test_rebindShadowedVariable , test_rebindCapturedVariable - , prop_printing_parsing_roundtrip + , test_printing_parsing_roundtrip ] From 8f0ab8ab5420e4915e6d5e5bfbc7f822c4f24b15 Mon Sep 17 00:00:00 2001 From: Yura Lazaryev Date: Wed, 29 May 2024 09:57:53 +0200 Subject: [PATCH 3/4] Pretty-printing with indexes by default, simple representation by opt-in. --- .../Constitution/Validator/GoldenTests.hs | 6 +- plutus-benchmark/cek-calibration/Main.hs | 2 +- plutus-benchmark/nofib/exe/Main.hs | 6 +- plutus-benchmark/nofib/test/Spec.hs | 2 +- plutus-benchmark/script-contexts/test/Spec.hs | 2 +- ...aryev_4808_unique_names_roundtrip_tests.md | 3 + plutus-core/executables/plc/Main.hs | 4 +- .../executables/plutus/AnyProgram/IO.hs | 8 +- .../executables/plutus/Debugger/TUI/Event.hs | 6 +- .../executables/plutus/Debugger/TUI/Main.hs | 4 +- plutus-core/executables/plutus/GetOpt.hs | 10 +- plutus-core/executables/plutus/Types.hs | 4 +- .../src/PlutusCore/Executable/Common.hs | 24 +- .../src/PlutusCore/Executable/Parsers.hs | 4 +- .../src/PlutusCore/Executable/Types.hs | 2 +- .../Core/Instance/Pretty/Default.hs | 12 +- .../src/PlutusCore/DeBruijn/Internal.hs | 133 ++++----- .../PlutusCore/Evaluation/ErrorWithCause.hs | 2 +- .../src/PlutusCore/Evaluation/Result.hs | 2 +- .../plutus-core/src/PlutusCore/Name/Unique.hs | 14 +- .../src/PlutusCore/Parser/Builtin.hs | 4 + .../src/PlutusCore/Parser/ParserCommon.hs | 91 +++--- .../plutus-core/src/PlutusCore/Pretty.hs | 34 +-- .../src/PlutusCore/Pretty/Classic.hs | 27 +- .../src/PlutusCore/Pretty/ConfigName.hs | 131 ++------ .../src/PlutusCore/Pretty/Default.hs | 26 +- .../plutus-core/src/PlutusCore/Pretty/Plc.hs | 73 ++--- .../src/PlutusCore/Pretty/Readable.hs | 5 +- .../src/PlutusCore/Pretty/Utils.hs | 2 +- .../stdlib/PlutusCore/StdLib/Type.hs | 2 +- plutus-core/plutus-core/test/Names/Spec.hs | 15 +- .../plutus-core/test/Pretty/Readable.hs | 24 +- plutus-core/plutus-core/test/Spec.hs | 18 +- .../plutus-core/test/TypeSynthesis/Spec.hs | 13 +- .../plutus-ir/src/PlutusIR/Compiler/Error.hs | 2 +- .../src/PlutusIR/Core/Instance/Pretty.hs | 12 +- .../PlutusIR/Core/Instance/Pretty/Readable.hs | 15 +- .../plutus-ir/src/PlutusIR/Core/Type.hs | 282 ++++++++++-------- plutus-core/plutus-ir/src/PlutusIR/Error.hs | 2 +- .../PlutusIR/Analysis/RetainedSize/Tests.hs | 4 +- .../plutus-ir/test/PlutusIR/Core/Tests.hs | 2 +- .../plutus-ir/test/PlutusIR/Parser/Tests.hs | 24 +- .../plutus-ir/test/PlutusIR/Purity/Tests.hs | 5 +- .../Transform/EvaluateBuiltins/Tests.hs | 3 +- .../test/PlutusIR/Transform/Rename/Tests.hs | 18 +- .../PlutusIR/Transform/RewriteRules/Tests.hs | 39 ++- .../PlutusCore/Generators/Hedgehog/Test.hs | 8 +- .../Generators/Hedgehog/TypeEvalCheck.hs | 2 +- .../PlutusCore/Generators/Hedgehog/Utils.hs | 6 +- plutus-core/testlib/PlutusCore/Test.hs | 73 ++--- .../Generators/QuickCheck/ShrinkTerms.hs | 2 +- plutus-core/testlib/PlutusIR/Test.hs | 43 +-- .../Core/Instance/Pretty/Default.hs | 4 +- .../Core/Instance/Pretty/Readable.hs | 2 +- .../Evaluation/Machine/Cek/EmitterMode.hs | 47 +-- .../untyped-plutus-core/test/Analysis/Spec.hs | 4 +- .../test/DeBruijn/UnDeBruijnify.hs | 2 +- .../test/Evaluation/Builtins/Definition.hs | 18 +- .../test/Evaluation/Golden.hs | 4 +- .../test/Evaluation/Machines.hs | 10 +- .../untyped-plutus-core/test/Generators.hs | 7 +- .../test/Transform/CaseOfCase/Test.hs | 2 +- .../test/Transform/Simplify/Lib.hs | 4 +- .../src/PlutusLedgerApi/Common/Eval.hs | 2 +- .../src/PlutusTx/Compiler/Error.hs | 2 +- .../src/PlutusTx/Compiler/Expr.hs | 2 +- plutus-tx-plugin/test/Lib.hs | 71 +++-- plutus-tx-plugin/test/Plugin/Debug/Spec.hs | 2 +- .../test/Plugin/Profiling/Spec.hs | 163 ++++++---- plutus-tx-plugin/test/StdLib/Spec.hs | 47 +-- plutus-tx/testlib/PlutusTx/Test.hs | 16 +- 71 files changed, 841 insertions(+), 825 deletions(-) create mode 100644 plutus-core/changelog.d/20240510_200705_Yuriy.Lazaryev_4808_unique_names_roundtrip_tests.md diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests.hs index 10d280a3caf..fb660389334 100644 --- 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/plutus-benchmark/cek-calibration/Main.hs b/plutus-benchmark/cek-calibration/Main.hs index 0741ffd74f6..99a2b84a2a8 100644 --- 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 index 06a8403ac18..86ea031bf71 100644 --- 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 index d7722d27ad9..f0fc5648215 100644 --- 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 index 7cd5cb5c0d7..916e10226f8 100644 --- 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/plutus-core/changelog.d/20240510_200705_Yuriy.Lazaryev_4808_unique_names_roundtrip_tests.md b/plutus-core/changelog.d/20240510_200705_Yuriy.Lazaryev_4808_unique_names_roundtrip_tests.md new file mode 100644 index 00000000000..e011c711290 --- /dev/null +++ b/plutus-core/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 index e822b729dfc..6589bea6622 100644 --- 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 index 38aabfc7a18..de25acb0563 100644 --- 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 index 642d2830241..c0c76783e22 100644 --- 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 index 3fdc3903318..c17ac9a57c3 100644 --- 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 index 93dc745faec..b3db80e9eef 100644 --- 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 index 0653d3f0135..ab012b7c067 100644 --- 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 index 8333287d342..809064866c8 100644 --- 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 index 78784aa9234..3ee330301a1 100644 --- 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 index 61e7a3a116f..293047bb197 100644 --- 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 index d64c6275c9a..cdbb574f1f4 100644 --- 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 diff --git a/plutus-core/plutus-core/src/PlutusCore/DeBruijn/Internal.hs b/plutus-core/plutus-core/src/PlutusCore/DeBruijn/Internal.hs index 452c02356bd..03a924d6a35 100644 --- a/plutus-core/plutus-core/src/PlutusCore/DeBruijn/Internal.hs +++ b/plutus-core/plutus-core/src/PlutusCore/DeBruijn/Internal.hs @@ -9,41 +9,41 @@ {-# OPTIONS_GHC -Wno-identities #-} -- | Support for using de Bruijn indices for term and type names. -module PlutusCore.DeBruijn.Internal ( - Index (..), - HasIndex (..), - DeBruijn (..), - NamedDeBruijn (..), +module PlutusCore.DeBruijn.Internal + ( Index (..) + , HasIndex (..) + , DeBruijn (..) + , NamedDeBruijn (..) -- we follow the same approach as Renamed: expose the constructor from Internal module, -- but hide it in the parent module. - FakeNamedDeBruijn (..), - TyDeBruijn (..), - NamedTyDeBruijn (..), - FreeVariableError (..), - AsFreeVariableError (..), - Level (..), - LevelInfo (..), - declareUnique, - declareBinder, - withScope, - getIndex, - getUnique, - unNameDeBruijn, - unNameTyDeBruijn, - fakeNameDeBruijn, - fakeTyNameDeBruijn, - nameToDeBruijn, - tyNameToDeBruijn, - deBruijnToName, - deBruijnToTyName, - freeIndexThrow, - freeIndexAsConsistentLevel, - freeUniqueThrow, - runDeBruijnT, - deBruijnInitIndex, - toFake, - fromFake, -) where + , FakeNamedDeBruijn (..) + , TyDeBruijn (..) + , NamedTyDeBruijn (..) + , FreeVariableError (..) + , AsFreeVariableError (..) + , Level (..) + , LevelInfo (..) + , declareUnique + , declareBinder + , withScope + , getIndex + , getUnique + , unNameDeBruijn + , unNameTyDeBruijn + , fakeNameDeBruijn + , fakeTyNameDeBruijn + , nameToDeBruijn + , tyNameToDeBruijn + , deBruijnToName + , deBruijnToTyName + , freeIndexThrow + , freeIndexAsConsistentLevel + , freeUniqueThrow + , runDeBruijnT + , deBruijnInitIndex + , toFake + , fromFake + ) where import PlutusCore.Name.Unique import PlutusCore.Pretty @@ -95,7 +95,7 @@ the optimized `Flat DeBruijn` instance. This is ok, because `FND<->D` are isomorphic. -} -{-| A relative index used for de Bruijn identifiers. +{- | A relative index used for de Bruijn identifiers. FIXME: downside of using newtype+Num instead of type-synonym is that `-Woverflowed-literals` does not work, e.g.: `DeBruijn (-1)` has no warning. To trigger the warning you have to bypass @@ -116,14 +116,14 @@ data NamedDeBruijn = NamedDeBruijn {ndbnString :: !T.Text, ndbnIndex :: !Index} deriving stock (Show, Generic, Read) deriving anyclass (Hashable, NFData) -{-| A wrapper around `NamedDeBruijn` that *must* hold the invariant of name=`fakeName`. +{- | A wrapper around `NamedDeBruijn` that *must* hold the invariant of name=`fakeName`. We do not export the `FakeNamedDeBruijn` constructor: the projection `FND->ND` is safe but injection `ND->FND` is unsafe, thus they are not isomorphic. See Note [Why newtype FakeNamedDeBruijn] -} -newtype FakeNamedDeBruijn = FakeNamedDeBruijn { unFakeNamedDeBruijn :: NamedDeBruijn } +newtype FakeNamedDeBruijn = FakeNamedDeBruijn {unFakeNamedDeBruijn :: NamedDeBruijn} deriving newtype (Show, Eq, Hashable, NFData, PrettyBy config) toFake :: DeBruijn -> FakeNamedDeBruijn @@ -164,15 +164,14 @@ instance Wrapped TyDeBruijn instance (HasPrettyConfigName config) => PrettyBy config NamedDeBruijn where prettyBy config (NamedDeBruijn txt (Index ix)) - -- See Note [Pretty-printing names with uniques] - | showsUnique = pretty . toPrintedName $ txt <> "_i" <> render (pretty ix) + | showsUnique = pretty $ toPrintedName txt <> "!" <> render (pretty ix) | otherwise = pretty $ toPrintedName txt where PrettyConfigName showsUnique = toPrettyConfigName config instance (HasPrettyConfigName config) => PrettyBy config DeBruijn where prettyBy config (DeBruijn (Index ix)) - | showsUnique = "i" <> pretty ix + | showsUnique = "!" <> pretty ix | otherwise = "" where PrettyConfigName showsUnique = toPrettyConfigName config @@ -304,12 +303,12 @@ getUnique ix h = do -- (absolute) level. h ix -unNameDeBruijn :: - NamedDeBruijn -> DeBruijn +unNameDeBruijn + :: NamedDeBruijn -> DeBruijn unNameDeBruijn (NamedDeBruijn _ ix) = DeBruijn ix -unNameTyDeBruijn :: - NamedTyDeBruijn -> TyDeBruijn +unNameTyDeBruijn + :: NamedTyDeBruijn -> TyDeBruijn unNameTyDeBruijn (NamedTyDeBruijn db) = TyDeBruijn $ unNameDeBruijn db fakeNameDeBruijn :: DeBruijn -> NamedDeBruijn @@ -318,32 +317,32 @@ fakeNameDeBruijn = coerce . toFake fakeTyNameDeBruijn :: TyDeBruijn -> NamedTyDeBruijn fakeTyNameDeBruijn (TyDeBruijn n) = NamedTyDeBruijn $ fakeNameDeBruijn n -nameToDeBruijn :: - (MonadReader LevelInfo m) => - (Unique -> m Index) -> - Name -> - m NamedDeBruijn +nameToDeBruijn + :: (MonadReader LevelInfo m) + => (Unique -> m Index) + -> Name + -> m NamedDeBruijn nameToDeBruijn h (Name str u) = NamedDeBruijn str <$> getIndex u h -tyNameToDeBruijn :: - (MonadReader LevelInfo m) => - (Unique -> m Index) -> - TyName -> - m NamedTyDeBruijn +tyNameToDeBruijn + :: (MonadReader LevelInfo m) + => (Unique -> m Index) + -> TyName + -> m NamedTyDeBruijn tyNameToDeBruijn h (TyName n) = NamedTyDeBruijn <$> nameToDeBruijn h n -deBruijnToName :: - (MonadReader LevelInfo m) => - (Index -> m Unique) -> - NamedDeBruijn -> - m Name +deBruijnToName + :: (MonadReader LevelInfo m) + => (Index -> m Unique) + -> NamedDeBruijn + -> m Name deBruijnToName h (NamedDeBruijn str ix) = Name str <$> getUnique ix h -deBruijnToTyName :: - (MonadReader LevelInfo m) => - (Index -> m Unique) -> - NamedTyDeBruijn -> - m TyName +deBruijnToTyName + :: (MonadReader LevelInfo m) + => (Index -> m Unique) + -> NamedTyDeBruijn + -> m TyName deBruijnToTyName h (NamedTyDeBruijn n) = TyName <$> deBruijnToName h n -- | The default handler of throwing an error upon encountering a free name (unique). @@ -362,10 +361,10 @@ These generated uniques remain free; i.e. if the original term was open, it wil after applying this handler. These generated free uniques are consistent across the open term (by using a state cache). -} -freeIndexAsConsistentLevel :: - (MonadReader LevelInfo m, MonadState (M.Map Level Unique) m, MonadQuote m) => - Index -> - m Unique +freeIndexAsConsistentLevel + :: (MonadReader LevelInfo m, MonadState (M.Map Level Unique) m, MonadQuote m) + => Index + -> m Unique freeIndexAsConsistentLevel ix = do cache <- get LevelInfo current _ <- ask diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/ErrorWithCause.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/ErrorWithCause.hs index 146d74d8b75..e5bad574184 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/ErrorWithCause.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/ErrorWithCause.hs @@ -54,7 +54,7 @@ instance (PrettyBy config cause, PrettyBy config err) => instance (PrettyPlc cause, PrettyPlc err) => Show (ErrorWithCause err cause) where - show = render . prettyPlcReadableDebug + show = render . prettyPlcReadableSimple deriving anyclass instance (PrettyPlc cause, PrettyPlc err, Typeable cause, Typeable err) => Exception (ErrorWithCause err cause) diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Result.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Result.hs index caf61ddca47..00b771a6974 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Result.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Result.hs @@ -130,7 +130,7 @@ instance PrettyBy config a => PrettyBy config (EvaluationResult a) where prettyBy _ EvaluationFailure = "Failure" instance PrettyClassic a => Pretty (EvaluationResult a) where - pretty = prettyClassicDef + pretty = prettyClassic -- | Check whether an 'EvaluationResult' is an 'EvaluationSuccess'. isEvaluationSuccess :: EvaluationResult a -> Bool diff --git a/plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs b/plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs index fc2bcc5809d..d07e721d1b3 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Name/Unique.hs @@ -106,8 +106,7 @@ data Named a = Named instance (HasPrettyConfigName config) => PrettyBy config Name where prettyBy config (Name txt (Unique uniq)) - -- See Note [Pretty-printing names with uniques] - | showsUnique = pretty . toPrintedName $ txt <> "_" <> render (pretty uniq) + | showsUnique = pretty $ toPrintedName txt <> "-" <> render (pretty uniq) | otherwise = pretty $ toPrintedName txt where PrettyConfigName showsUnique = toPrettyConfigName config @@ -182,14 +181,3 @@ instance HasUnique TyName TypeUnique -- | A lens focused on the 'Unique' of a name. theUnique :: (HasUnique name unique) => Lens' name Unique theUnique = unique . coerced - -{- Note [Pretty-printing names with uniques] - -Our parser can't currently parse unqiues properly. As a hacky workaround, when pretty-printing, -we print the uniques as part of the names. That is, if the name proper is @++@ and the -unique is 123, then it is printed as @`++_123`@, rather than @`++`_123@. - -This way, when it is parsed back, the entire @`++_123`@ becomes the name proper. This works: -a program would be alpha-equivalent after being pretty-printed and then parsed back. But we -should still fix this and do it properly. --} diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs b/plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs index 2beb0485580..419008947ef 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Parser/Builtin.hs @@ -148,3 +148,7 @@ constant = do Refl <- reoption $ checkStar uni -- Parse the constant of the type represented by the type tag. someValueOf uni <$> constantOf ExpectParensYes uni + +data ExpectParens + = ExpectParensYes + | ExpectParensNo diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs b/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs index d211e97da9e..006b5250ecc 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs @@ -5,20 +5,22 @@ -- | Common functions for parsers of UPLC, PLC, and PIR. module PlutusCore.Parser.ParserCommon where -import Control.Monad (void, when) +import Control.Monad (when) import Control.Monad.Except (MonadError) import Control.Monad.Reader (ReaderT, ask, local, runReaderT) -import Control.Monad.State (MonadState (..), StateT, evalStateT) +import Control.Monad.State (StateT, evalStateT) import Data.Map qualified as M -import Data.Text qualified as T +import Data.Text (Text) import Text.Megaparsec hiding (ParseError, State, parse, some) import Text.Megaparsec.Char (char, space1) import Text.Megaparsec.Char.Lexer qualified as Lex hiding (hexadecimal) +import Control.Monad.State.Class (MonadState, get, put) import PlutusCore.Annotation import PlutusCore.Core.Type import PlutusCore.Error -import PlutusCore.Name.Unique +import PlutusCore.Name.Unique (Name (..), Unique (..), isIdentifierChar, isIdentifierStartingChar, + isQuotedIdentifierChar) import PlutusCore.Quote {- Note [Whitespace invariant] @@ -27,35 +29,17 @@ sure to enclose every 'Parser' that doesn't consume trailing whitespce (e.g. 'ta 'manyTill', 'Lex.decimal' etc) in a call to 'lexeme'. -} -newtype ParserState = ParserState {identifiers :: M.Map T.Text Unique} +newtype ParserState = ParserState {identifiers :: M.Map Text Unique} deriving stock (Show) type Parser = - ParsecT ParserError T.Text (StateT ParserState (ReaderT (Maybe Version) Quote)) + ParsecT ParserError Text (StateT ParserState (ReaderT (Maybe Version) Quote)) instance (Stream s, MonadQuote m) => MonadQuote (ParsecT e s m) initial :: ParserState initial = ParserState M.empty -{- | Return the unique identifier of a name. -If it's not in the current parser state, map the name to a fresh id -and add it to the state. Used in the Name parser. --} -intern :: - (MonadState ParserState m, MonadQuote m) => - T.Text -> - m Unique -intern n = do - st <- get - case M.lookup n (identifiers st) of - Just u -> return u - Nothing -> do - fresh <- freshUnique - let identifiers' = M.insert n fresh $ identifiers st - put $ ParserState identifiers' - return fresh - -- | Get the version of the program being parsed, if we know it. getVersion :: Parser (Maybe Version) getVersion = ask @@ -75,22 +59,22 @@ whenVersion p act = do Nothing -> pure () Just v -> when (p v) act -parse :: - (AsParserErrorBundle e, MonadError e m, MonadQuote m) => - Parser a -> - String -> - T.Text -> - m a +parse + :: (AsParserErrorBundle e, MonadError e m, MonadQuote m) + => Parser a + -> String + -> Text + -> m a parse p file str = do let res = fmap toErrorB (runReaderT (evalStateT (runParserT p file str) initial) Nothing) throwingEither _ParserErrorBundle =<< liftQuote res -toErrorB :: Either (ParseErrorBundle T.Text ParserError) a -> Either ParserErrorBundle a +toErrorB :: Either (ParseErrorBundle Text ParserError) a -> Either ParserErrorBundle a toErrorB (Left err) = Left $ ParseErrorB err toErrorB (Right a) = Right a -- | Generic parser function in which the file path is just "test". -parseGen :: (AsParserErrorBundle e, MonadError e m, MonadQuote m) => Parser a -> T.Text -> m a +parseGen :: (AsParserErrorBundle e, MonadError e m, MonadQuote m) => Parser a -> Text -> m a parseGen stuff = parse stuff "test" -- | Space consumer. @@ -128,7 +112,7 @@ withSpan = (<* whitespace) . withSpan' lexeme :: Parser a -> Parser a lexeme = Lex.lexeme whitespace -symbol :: T.Text -> Parser T.Text +symbol :: Text -> Parser Text symbol = Lex.symbol whitespace inParens :: Parser a -> Parser a @@ -153,26 +137,43 @@ toSrcSpan start end = version :: Parser Version version = trailingWhitespace $ do x <- Lex.decimal - void $ char '.' + _ <- char '.' y <- Lex.decimal - void $ char '.' + _ <- char '.' Version x y <$> Lex.decimal -- | Parses a `Name`. Does not consume leading or trailing whitespaces. name :: Parser Name name = try $ parseUnquoted <|> parseQuoted where + parseUnquoted :: Parser Name parseUnquoted = do - void $ lookAhead (satisfy isIdentifierStartingChar) + _ <- lookAhead (satisfy isIdentifierStartingChar) str <- takeWhileP (Just "identifier-unquoted") isIdentifierChar - Name str <$> intern str + Name str <$> uniqueSuffix str + + parseQuoted :: Parser Name parseQuoted = do - void $ char '`' - void $ lookAhead (satisfy isQuotedIdentifierChar) + _ <- char '`' + _ <- lookAhead (satisfy isQuotedIdentifierChar) str <- takeWhileP (Just "identifier-quoted") isQuotedIdentifierChar - void $ char '`' - Name str <$> intern str - -data ExpectParens - = ExpectParensYes - | ExpectParensNo + _ <- char '`' + Name str <$> uniqueSuffix str + + -- Tries to parse a `Unique` value. + -- If it fails then looks up the `Unique` value for the given name. + -- If lookup fails too then generates a fresh `Unique` value. + uniqueSuffix :: Text -> Parser Unique + uniqueSuffix nameStr = try (Unique <$> (char '-' *> Lex.decimal)) <|> uniqueForName nameStr + + -- Return the unique identifier of a name. + -- If it's not in the current parser state, map the name to a fresh id and add it to the state. + uniqueForName :: (MonadState ParserState m, MonadQuote m) => Text -> m Unique + uniqueForName nameStr = do + parserState <- get + case M.lookup nameStr (identifiers parserState) of + Just u -> pure u + Nothing -> do + fresh <- freshUnique + put $ ParserState $ M.insert nameStr fresh $ identifiers parserState + pure fresh diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty.hs index 05b594fb866..536c9d8426f 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty.hs @@ -12,10 +12,10 @@ module PlutusCore.Pretty , displayBy , juxtRenderContext -- * Defaults - , prettyPlcDef - , displayPlcDef - , prettyPlcDebug - , displayPlcDebug + , prettyPlc + , displayPlc + , prettyPlcSimple + , displayPlcSimple -- * Global configuration , CondensedErrors (..) , DefaultPrettyPlcStrategy @@ -23,30 +23,30 @@ module PlutusCore.Pretty , PrettyConfigPlcStrategy (..) , PrettyConfigPlc (..) , PrettyPlc - , defPrettyConfigPlcOptions - , defPrettyConfigPlcClassic - , debugPrettyConfigPlcClassic - , defPrettyConfigPlcReadable - , debugPrettyConfigPlcReadable + , prettyConfigPlcOptions + , prettyConfigPlcClassic + , prettyConfigPlcClassicSimple + , prettyConfigPlcReadable + , prettyConfigPlcReadableSimple -- * Custom functions for PLC types. - , prettyPlcClassicDef - , prettyPlcClassicDebug - , prettyPlcReadableDef - , prettyPlcReadableDebug + , prettyPlcClassic + , prettyPlcClassicSimple + , prettyPlcReadable + , prettyPlcReadableSimple , prettyPlcCondensedErrorBy , displayPlcCondensedErrorClassic -- * Names , PrettyConfigName (..) , HasPrettyConfigName (..) - , defPrettyConfigName - , debugPrettyConfigName + , prettyConfigName + , prettyConfigNameSimple -- * Classic view , PrettyConfigClassic (..) , PrettyClassicBy , PrettyClassic , consAnnIf - , prettyClassicDef - , prettyClassicDebug + , prettyClassic + , prettyClassicSimple -- * Readable view , ShowKinds (..) , PrettyConfigReadable (..) diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty/Classic.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty/Classic.hs index d5983f04190..98f97a24df7 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty/Classic.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty/Classic.hs @@ -12,10 +12,10 @@ module PlutusCore.Pretty.Classic , PrettyParens , juxtRenderContext , consAnnIf - , defPrettyConfigClassic - , debugPrettyConfigClassic - , prettyClassicDef - , prettyClassicDebug + , prettyConfigClassic + , prettyConfigClassicSimple + , prettyClassic + , prettyClassicSimple ) where import PlutusPrelude @@ -30,6 +30,7 @@ data PrettyConfigClassic configName = PrettyConfigClassic { _pccConfigName :: configName -- ^ How to pretty-print names. , _pccDisplayAnn :: Bool -- ^ Whether to display annotations. } + deriving stock (Show) type instance HasPrettyDefaults (PrettyConfigClassic _) = 'True @@ -50,16 +51,16 @@ isEmptyDoc _ = False consAnnIf :: Pretty ann => PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann] consAnnIf config ann rest = filter (not . isEmptyDoc) [pretty ann | _pccDisplayAnn config] ++ rest -defPrettyConfigClassic :: PrettyConfigClassic PrettyConfigName -defPrettyConfigClassic = PrettyConfigClassic defPrettyConfigName False +prettyConfigClassic :: PrettyConfigClassic PrettyConfigName +prettyConfigClassic = PrettyConfigClassic prettyConfigName False -debugPrettyConfigClassic :: PrettyConfigClassic PrettyConfigName -debugPrettyConfigClassic = PrettyConfigClassic debugPrettyConfigName False +prettyConfigClassicSimple :: PrettyConfigClassic PrettyConfigName +prettyConfigClassicSimple = PrettyConfigClassic prettyConfigNameSimple False -- | Pretty-print a value in the default mode using the classic view. -prettyClassicDef :: PrettyClassic a => a -> Doc ann -prettyClassicDef = prettyBy defPrettyConfigClassic +prettyClassic :: PrettyClassic a => a -> Doc ann +prettyClassic = prettyBy prettyConfigClassic --- | Pretty-print a value in the debug mode using the classic view. -prettyClassicDebug :: PrettyClassic a => a -> Doc ann -prettyClassicDebug = prettyBy debugPrettyConfigClassic +-- | Pretty-print a value in the simple mode using the classic view. +prettyClassicSimple :: PrettyClassic a => a -> Doc ann +prettyClassicSimple = prettyBy prettyConfigClassicSimple diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty/ConfigName.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty/ConfigName.hs index fd8afcdadda..7d248459d18 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty/ConfigName.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty/ConfigName.hs @@ -1,126 +1,39 @@ --- editorconfig-checker-disable-file {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} -module PlutusCore.Pretty.ConfigName - ( PrettyConfigName (..) - , HasPrettyConfigName (..) - , defPrettyConfigName - , debugPrettyConfigName - ) where - -import Data.Coerce -import Text.PrettyBy -import Text.PrettyBy.Fixity - -{- Note [PLC names pretty-printing] -UPDATE: We no longer have such fancy names that this note describes. -However it's still nice to have a working boileplate-free solution for sophisticated cases. - -There are several possible designs on how to pretty-print PLC names. We choose the simplest one -which leads to less boilerplate on the implementation side and more concise API. The trade-off is -that it's completely inextensible and the pretty-printer configuration for PLC names is hardcoded -to 'PrettyConfigName'. Originally I tried to do a clever thing and allow different pretty-printer -configs for PLC names, but it turned out to be very complicated and the API would make users unhappy. -We may try to improve the current design later, but for now it works fine. - -Here is how the current design is motivated: - -Consider the 'PrettyConfigClassic' class - - newtype PrettyConfigClassic configName = PrettyConfigClassic - { _pccConfigName :: configName - } - -(which only specifies how to print a PLC name) and this hypothethical instance: - - instance PrettyBy configName (tyname a) => - PrettyBy (PrettyConfigClassic configName) (Type tyname a) - -which determines how to pretty-print a 'Type' provided you know how to pretty-print a @tyname a@ -by a 'configName'. "Makes sense" you might think, but our names are tricky: - - newtype TyNameWithKind a = TyNameWithKind { unTyNameWithKind :: TyName (a, Kind a) } - -Here in order to pretty-print a 'TyNameWithKind', 'configName' must specify how to pretty-print -a 'Kind'. And there are at least two strategies to pretty-print a 'Kind': 'Classic' and 'Refined'. -I.e. 'configName' must specify not only a 'PrettyConfigName', but also a strategy to -pretty-print any PLC entity because this can be required in order to pretty-print a name. -Things become worse with - - type RenamedTerm a = Term TyNameWithKind NameWithType a - newtype NameWithType a = NameWithType (Name (a, RenamedType a)) -because in order to pretty-print a 'RenamedTerm' you have to provide a config that specifies -a pretty-printing strategy for 'Term' and has such 'configName' inside that specifies -a pretty-printing strategy for 'RenamedType' (because it's required in order to pretty-print -'NameWithType') which has a 'configName' that specifies a pretty-printing strategy for 'Kind' -(because it's required in order to pretty-print 'TyNameWithKind'). This is either a hell at the -type-level (completely unbearable) or a circular config at the term level which says -"whatever your level of nestedness is, I'm able to handle that". -That latter thing would look like - - data PrettyConfigPlcLoop - = PrettyConfigPlcLoopClassic (PrettyConfigClassic PrettyConfigPlc) - | PrettyConfigPlcLoopRefined (PrettyConfigRefined PrettyConfigPlc) - - data PrettyConfigPlc = PrettyConfigPlc - { _prettyConfigPlcName :: PrettyConfigName - , _prettyConfigPlcLoop :: PrettyConfigPlcLoop - } - -i.e. there is a 'PrettyConfigName' at the current level, but you can descend further and there -will be a a 'PrettyConfigName' as well. While this might work, we're not in the Inception movie -and hence we define - - instance PrettyBy (PrettyConfigClassic configName) (tyname a) => - PrettyBy (PrettyConfigClassic configName) (Type tyname a) - -i.e. require that a @tyname a@ must be pretty-printable with the same config as an entire 'Type'. - -... and immediately run into the O(n * m) number of instances problem: - - [Classic, Refined] x [Name, TyName, NameWithType, TyNameWithKind] - -where @[Classic, Refined]@ are pretty-printing strategies (we can add more in future) and -@[Name, TyName, NameWithType, TyNameWithKind]@ are PLC names (we will likely add more in future). -We do not need this level of extensibility (pretty-printing names differently depending on a -pretty-printing strategy used), so we do the following twist: for any pretty-printing strategy -we require that it must contain a PLC names pretty-printing config and then define a single instance -for each of the PLC names. E.g. for 'Name' it looks like this: - - instance HasPrettyConfigName config => PrettyBy config (Name ann) where - -i.e. "you can pretty-print a 'Name' using any config as long as a 'PrettyConfigName' can be -extracted from it". This results in O(n + m) number of instances, with 'HasPrettyConfigName' -instances being defined like - - instance configName ~ PrettyConfigName => HasPrettyConfigName (PrettyConfigClassic configName) where - toPrettyConfigName = _pccConfigName +module PlutusCore.Pretty.ConfigName + ( PrettyConfigName (..) + , HasPrettyConfigName (..) + , prettyConfigName + , prettyConfigNameSimple + ) where -Here we also hardcode the PLC names pretty-printing config to be 'PrettyConfigName' which sometimes -contains redundant information (e.g. to pretty-print a 'Name' the '_pcnShowsAttached' field is not -required). This is something that we may try to improve later. --} +import Data.Coerce (coerce) +import Text.PrettyBy (HasPrettyDefaults) +import Text.PrettyBy.Fixity (Sole (Sole)) -- | A config that determines how to pretty-print a PLC name. newtype PrettyConfigName = PrettyConfigName - { _pcnShowsUnique :: Bool -- ^ Whether to show the 'Unique' of a name or not. - } + { _pcnShowsUnique :: Bool + -- ^ Whether to show the 'Unique' of a name or not. + } + deriving stock (Eq, Show) type instance HasPrettyDefaults PrettyConfigName = 'True -- | A class of configs from which a 'PrettyConfigName' can be extracted. class HasPrettyConfigName config where - toPrettyConfigName :: config -> PrettyConfigName + toPrettyConfigName :: config -> PrettyConfigName instance HasPrettyConfigName (Sole PrettyConfigName) where - toPrettyConfigName = coerce + toPrettyConfigName = coerce + +-- | The 'PrettyConfigName' used by default: print 'Unique' indexes after nams. +prettyConfigName :: PrettyConfigName +prettyConfigName = PrettyConfigName{_pcnShowsUnique = True} --- | The 'PrettyConfigName' used by default: don't print 'Unique's. -defPrettyConfigName :: PrettyConfigName -defPrettyConfigName = PrettyConfigName False +-- | The 'PrettyConfigName' to be used when 'Unique' indices don't matter. Easier to read. +prettyConfigNameSimple :: PrettyConfigName +prettyConfigNameSimple = PrettyConfigName{_pcnShowsUnique = False} --- | The 'PrettyConfigName' used for debugging: print 'Unique's. -debugPrettyConfigName :: PrettyConfigName -debugPrettyConfigName = PrettyConfigName True diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty/Default.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty/Default.hs index 9baab6a44e5..f4fc8eee15c 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty/Default.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty/Default.hs @@ -1,8 +1,8 @@ module PlutusCore.Pretty.Default - ( prettyPlcDef - , displayPlcDef - , prettyPlcDebug - , displayPlcDebug + ( prettyPlc + , displayPlc + , prettyPlcSimple + , displayPlcSimple , displayPlcCondensedErrorClassic ) where @@ -11,22 +11,22 @@ import PlutusPrelude import PlutusCore.Pretty.Plc -- | Pretty-print a value in the default mode using the classic view. -prettyPlcDef :: PrettyPlc a => a -> Doc ann -prettyPlcDef = prettyPlcClassicDef +prettyPlc :: PrettyPlc a => a -> Doc ann +prettyPlc = prettyPlcClassic -- | Render a value to 'String' in the default mode using the classic view. -displayPlcDef :: (PrettyPlc a, Render str) => a -> str -displayPlcDef = render . prettyPlcClassicDef +displayPlc :: (PrettyPlc a, Render str) => a -> str +displayPlc = render . prettyPlcClassic -- | Pretty-print a value in the debug mode using the classic view. -prettyPlcDebug :: PrettyPlc a => a -> Doc ann -prettyPlcDebug = prettyPlcClassicDebug +prettyPlcSimple :: PrettyPlc a => a -> Doc ann +prettyPlcSimple = prettyPlcClassicSimple -- | Render a value to 'String' in the debug mode using the classic view. -displayPlcDebug :: (PrettyPlc a, Render str) => a -> str -displayPlcDebug = render . prettyPlcClassicDebug +displayPlcSimple :: (PrettyPlc a, Render str) => a -> str +displayPlcSimple = render . prettyPlcClassicSimple -- | Render an error to 'String' in the condensed manner using the classic view. displayPlcCondensedErrorClassic :: (PrettyPlc a, Render str) => a -> str displayPlcCondensedErrorClassic = - render . prettyPlcCondensedErrorBy defPrettyConfigPlcClassic + render . prettyPlcCondensedErrorBy prettyConfigPlcClassic diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty/Plc.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty/Plc.hs index 32261f16901..91c34b00e41 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty/Plc.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty/Plc.hs @@ -17,16 +17,16 @@ module PlutusCore.Pretty.Plc , PrettyConfigPlc (..) , PrettyPlc , DefaultPrettyPlcStrategy - , defPrettyConfigPlcOptions - , defPrettyConfigPlcClassic - , debugPrettyConfigPlcClassic - , defPrettyConfigPlcReadable - , debugPrettyConfigPlcReadable + , prettyConfigPlcOptions + , prettyConfigPlcClassic + , prettyConfigPlcClassicSimple + , prettyConfigPlcReadable + , prettyConfigPlcReadableSimple -- * Custom functions for PLC types. - , prettyPlcClassicDef - , prettyPlcClassicDebug - , prettyPlcReadableDef - , prettyPlcReadableDebug + , prettyPlcClassic + , prettyPlcClassicSimple + , prettyPlcReadable + , prettyPlcReadableSimple , prettyPlcCondensedErrorBy ) where @@ -46,17 +46,20 @@ data CondensedErrors newtype PrettyConfigPlcOptions = PrettyConfigPlcOptions { _pcpoCondensedErrors :: CondensedErrors } + deriving stock (Show) -- | Strategy for pretty-printing PLC entities. data PrettyConfigPlcStrategy = PrettyConfigPlcClassic (PrettyConfigClassic PrettyConfigName) | PrettyConfigPlcReadable (PrettyConfigReadable PrettyConfigName) + deriving stock (Show) -- | Global configuration used for pretty-printing PLC entities. data PrettyConfigPlc = PrettyConfigPlc { _pcpOptions :: PrettyConfigPlcOptions , _pcpStrategy :: PrettyConfigPlcStrategy } + deriving stock (Show) type instance HasPrettyDefaults PrettyConfigPlc = 'True @@ -85,50 +88,50 @@ instance DefaultPrettyPlcStrategy a => PrettyBy PrettyConfigPlc (PrettyAny a) wh -- | The 'PrettyConfigPlcOptions' used by default: -- print errors in full. -defPrettyConfigPlcOptions :: PrettyConfigPlcOptions -defPrettyConfigPlcOptions = PrettyConfigPlcOptions CondensedErrorsNo +prettyConfigPlcOptions :: PrettyConfigPlcOptions +prettyConfigPlcOptions = PrettyConfigPlcOptions CondensedErrorsNo -- | The 'PrettyConfigPlc' used by default: -- use the classic view and print neither 'Unique's, nor name attachments. -defPrettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc -defPrettyConfigPlcClassic opts = - PrettyConfigPlc opts $ PrettyConfigPlcClassic defPrettyConfigClassic +prettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc +prettyConfigPlcClassic opts = + PrettyConfigPlc opts $ PrettyConfigPlcClassic prettyConfigClassic -- | The 'PrettyConfigPlc' used for debugging: -- use the classic view and print 'Unique's, but not name attachments. -debugPrettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc -debugPrettyConfigPlcClassic opts = - PrettyConfigPlc opts $ PrettyConfigPlcClassic debugPrettyConfigClassic +prettyConfigPlcClassicSimple :: PrettyConfigPlcOptions -> PrettyConfigPlc +prettyConfigPlcClassicSimple opts = + PrettyConfigPlc opts $ PrettyConfigPlcClassic prettyConfigClassicSimple -- | The 'PrettyConfigPlc' used by default and for readability: --- use the refined view and print neither 'Unique's, nor name attachments. -defPrettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc -defPrettyConfigPlcReadable opts = +-- use the refined view and print 'Unique's but not name attachments. +prettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc +prettyConfigPlcReadable opts = PrettyConfigPlc opts . PrettyConfigPlcReadable $ - topPrettyConfigReadable defPrettyConfigName def + botPrettyConfigReadable prettyConfigName def -- | The 'PrettyConfigPlc' used for debugging and readability: --- use the refined view and print 'Unique's, but not name attachments. -debugPrettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc -debugPrettyConfigPlcReadable opts = +-- use the refined view and print neither 'Unique's nor name attachments. +prettyConfigPlcReadableSimple :: PrettyConfigPlcOptions -> PrettyConfigPlc +prettyConfigPlcReadableSimple opts = PrettyConfigPlc opts . PrettyConfigPlcReadable $ - topPrettyConfigReadable debugPrettyConfigName def + botPrettyConfigReadable prettyConfigNameSimple def -- | Pretty-print a PLC value in the default mode using the classic view. -prettyPlcClassicDef :: PrettyPlc a => a -> Doc ann -prettyPlcClassicDef = prettyBy $ defPrettyConfigPlcClassic defPrettyConfigPlcOptions +prettyPlcClassic :: PrettyPlc a => a -> Doc ann +prettyPlcClassic = prettyBy $ prettyConfigPlcClassic prettyConfigPlcOptions --- | Pretty-print a PLC value in the debug mode using the classic view. -prettyPlcClassicDebug :: PrettyPlc a => a -> Doc ann -prettyPlcClassicDebug = prettyBy $ debugPrettyConfigPlcClassic defPrettyConfigPlcOptions +-- | Pretty-print a PLC value witout unique indices using the classic view. +prettyPlcClassicSimple :: PrettyPlc a => a -> Doc ann +prettyPlcClassicSimple = prettyBy $ prettyConfigPlcClassicSimple prettyConfigPlcOptions -- | Pretty-print a PLC value in the default mode using the readable view. -prettyPlcReadableDef :: PrettyPlc a => a -> Doc ann -prettyPlcReadableDef = prettyBy $ defPrettyConfigPlcReadable defPrettyConfigPlcOptions +prettyPlcReadable :: PrettyPlc a => a -> Doc ann +prettyPlcReadable = prettyBy $ prettyConfigPlcReadable prettyConfigPlcOptions --- | Pretty-print a PLC value in the debug mode using the readable view. -prettyPlcReadableDebug :: PrettyPlc a => a -> Doc ann -prettyPlcReadableDebug = prettyBy $ debugPrettyConfigPlcReadable defPrettyConfigPlcOptions +-- | Pretty-print a PLC value witout unique indices using the readable view. +prettyPlcReadableSimple :: PrettyPlc a => a -> Doc ann +prettyPlcReadableSimple = prettyBy $ prettyConfigPlcReadableSimple prettyConfigPlcOptions -- | Pretty-print a PLC value using the condensed way (see 'CondensedErrors') -- of pretty-printing PLC errors (in case there are any). diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty/Readable.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty/Readable.hs index b6bbbddeef2..247f3e8da2b 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty/Readable.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty/Readable.hs @@ -43,6 +43,7 @@ data PrettyConfigReadable configName = PrettyConfigReadable , _pcrRenderContext :: RenderContext , _pcrShowKinds :: ShowKinds } + deriving stock (Show) type instance HasPrettyDefaults (PrettyConfigReadable _) = 'True @@ -70,7 +71,7 @@ instance HasRenderContext (PrettyConfigReadable configName) where renderContext = pcrRenderContext {- | For rendering things in a readable manner regardless of the pretty-printing function chosen. -I.e. all of 'show', 'pretty', 'prettyClassicDef' will use 'PrettyReadable' instead of doing what +I.e. all of 'show', 'pretty', 'prettyClassic' will use 'PrettyReadable' instead of doing what they normally do. @prettyBy config (AsReadable x)@ requires @config@ to have a 'PrettyConfigName' and respects it. @@ -90,7 +91,7 @@ instance prettyBy (botPrettyConfigReadable (toPrettyConfigName config) def) x instance (PrettyReadable a) => Show (AsReadable a) where - show = displayBy $ Sole defPrettyConfigName + show = displayBy $ Sole prettyConfigName instance (PrettyReadable a) => Pretty (AsReadable a) where pretty = viaShow diff --git a/plutus-core/plutus-core/src/PlutusCore/Pretty/Utils.hs b/plutus-core/plutus-core/src/PlutusCore/Pretty/Utils.hs index 1a4d399b86b..e8eef31ea35 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Pretty/Utils.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Pretty/Utils.hs @@ -19,4 +19,4 @@ asBytes x = Text 2 $ T.pack $ addLeadingZero $ showHex x mempty | otherwise = id prettyBytes :: BS.ByteString -> Doc ann -prettyBytes b = "#" <> fold (asBytes <$> BS.unpack b) +prettyBytes b = "#" <> foldMap asBytes (BS.unpack b) diff --git a/plutus-core/plutus-core/stdlib/PlutusCore/StdLib/Type.hs b/plutus-core/plutus-core/stdlib/PlutusCore/StdLib/Type.hs index 31f30942feb..bcff55db06c 100644 --- a/plutus-core/plutus-core/stdlib/PlutusCore/StdLib/Type.hs +++ b/plutus-core/plutus-core/stdlib/PlutusCore/StdLib/Type.hs @@ -510,7 +510,7 @@ instance Show IndicesLengthsMismatchException where show (IndicesLengthsMismatchException expected actual tyName) = concat [ "Wrong number of elements\n" , "expected: ", show expected, " , actual: ", show actual, "\n" - , "while constructing a ", displayPlcDef tyName + , "while constructing a ", displayPlc tyName ] -- | Get the kind of a data type having the kinds of its arguments. diff --git a/plutus-core/plutus-core/test/Names/Spec.hs b/plutus-core/plutus-core/test/Names/Spec.hs index d275a048c41..0bca667e5ec 100644 --- a/plutus-core/plutus-core/test/Names/Spec.hs +++ b/plutus-core/plutus-core/test/Names/Spec.hs @@ -20,7 +20,7 @@ import PlutusCore.Generators.Hedgehog.AST as AST (genName, genProgram, genTerm, import PlutusCore.Generators.Hedgehog.Interesting (fromInterestingTermGens) import PlutusCore.Mark (markNonFreshProgram) import PlutusCore.Parser qualified as Parser -import PlutusCore.Pretty (displayPlcDebug, pretty, render) +import PlutusCore.Pretty (display, displayPlcSimple) import PlutusCore.Rename.Internal (renameProgramM) import PlutusCore.Test (BindingRemoval (BindingRemovalNotOk), Prerename (PrerenameNo), brokenRename, checkFails, noMarkRename, test_scopingGood, test_scopingSpoilRenamer) @@ -133,9 +133,9 @@ test_rebindShadowedVariable = testCase "rebindShadowedVariable" do err = concat - [ displayPlcDebug l2 + [ displayPlcSimple l2 , " and " - , displayPlcDebug r2 + , displayPlcSimple r2 , " are supposed not to be equal, but they are equal" ] @@ -191,13 +191,10 @@ test_printing_parsing_roundtrip = prop_printing_parsing_roundtrip :: Property prop_printing_parsing_roundtrip = property $ generalizeT do name <- forAllPretty $ runAstGen genName - tripping name printName parseName + tripping name display parse where - printName :: Name -> String - printName = render . pretty - - parseName :: String -> Either (PlutusCore.Error DefaultUni DefaultFun ()) Name - parseName str = runQuoteT do + parse :: String -> Either (PlutusCore.Error DefaultUni DefaultFun ()) Name + parse str = runQuoteT do Parser.parse Parser.name "test_printing_parsing_roundtrip" (Text.pack str) test_names :: TestTree diff --git a/plutus-core/plutus-core/test/Pretty/Readable.hs b/plutus-core/plutus-core/test/Pretty/Readable.hs index a346e264b71..3cf2ef8cd69 100644 --- a/plutus-core/plutus-core/test/Pretty/Readable.hs +++ b/plutus-core/plutus-core/test/Pretty/Readable.hs @@ -14,20 +14,21 @@ import Test.Tasty.Extras import Test.Tasty prettyConfigReadable :: PrettyConfigPlc -prettyConfigReadable - = PrettyConfigPlc defPrettyConfigPlcOptions +prettyConfigReadable = + PrettyConfigPlc prettyConfigPlcOptions . PrettyConfigPlcReadable - $ botPrettyConfigReadable defPrettyConfigName def + $ botPrettyConfigReadable prettyConfigNameSimple def -testReadable :: PrettyPlc a => TestName -> a -> TestNested +testReadable :: (PrettyPlc a) => TestName -> a -> TestNested testReadable name = nestedGoldenVsDoc name "" . prettyBy prettyConfigReadable test_PrettyReadable :: TestTree test_PrettyReadable = - testGroup "Bundles" - [ folder stdLib - , folder examples - ] + testGroup + "Bundles" + [ folder stdLib + , folder examples + ] where folder :: Pretty fun => PlcFolderContents DefaultUni fun -> TestTree folder @@ -36,6 +37,7 @@ test_PrettyReadable = test_Pretty :: TestTree test_Pretty = - testGroup "pretty" - [ test_PrettyReadable - ] + testGroup + "pretty" + [ test_PrettyReadable + ] diff --git a/plutus-core/plutus-core/test/Spec.hs b/plutus-core/plutus-core/test/Spec.hs index daf13d8b770..5bfccb91245 100644 --- a/plutus-core/plutus-core/test/Spec.hs +++ b/plutus-core/plutus-core/test/Spec.hs @@ -159,7 +159,7 @@ testLexConstant :: Assertion testLexConstant = for_ smallConsts $ \t -> do let res :: Either ParserErrorBundle (Term TyName Name DefaultUni DefaultFun SrcSpan) - res = runQuoteT $ parseTerm $ displayPlcDef t + res = runQuoteT $ parseTerm $ displayPlc t -- using `void` here to get rid of `SrcSpan` fmap void res @?= Right t where @@ -182,7 +182,7 @@ testLexConstant = genConstantForTest :: AstGen (Some (ValueOf DefaultUni)) genConstantForTest = Gen.frequency - [ (3, someValue <$> pure ()) + [ (3, pure (someValue ())) , (3, someValue <$> Gen.bool) , -- Smallish Integers (5, someValue <$> Gen.integral (Range.linear (-k1) k1)) @@ -211,7 +211,7 @@ genConstantForTest = propLexConstant :: Property propLexConstant = withTests (1000 :: Hedgehog.TestLimit) . property $ do term <- forAllPretty $ Constant () <$> runAstGen genConstantForTest - Hedgehog.tripping term displayPlcDef (fmap void . parseTm) + Hedgehog.tripping term displayPlc (fmap void . parseTm) where parseTm :: T.Text -> @@ -226,7 +226,7 @@ propParser = property $ do prog <- TextualProgram <$> forAllPretty (runAstGen genProgram) Hedgehog.tripping prog - (displayPlcDef . unTextualProgram) + (displayPlc . unTextualProgram) (\p -> fmap (TextualProgram . void) (parseProg p)) where parseProg :: @@ -242,7 +242,7 @@ asIO :: TestFunction -> FilePath -> IO BSL.ByteString asIO f = fmap (either errorgen (BSL.fromStrict . encodeUtf8) . f) . readFile errorgen :: (PrettyPlc a) => a -> BSL.ByteString -errorgen = BSL.fromStrict . encodeUtf8 . displayPlcDef +errorgen = BSL.fromStrict . encodeUtf8 . displayPlcSimple asGolden :: TestFunction -> TestName -> TestTree asGolden f file = goldenVsString file (file ++ ".golden") (asIO f file) @@ -275,7 +275,7 @@ printType :: m T.Text printType txt = runQuoteT $ - T.pack . show . pretty <$> do + render . prettyBy (prettyConfigPlcClassicSimple prettyConfigPlcOptions) <$> do scoped <- parseScoped txt config <- getDefTypeCheckConfig topSrcSpan inferTypeOfProgram config scoped @@ -293,12 +293,12 @@ format cfg = runQuoteT . fmap (displayBy cfg) . (rename <=< parseProgram) testsGolden :: [FilePath] -> TestTree testsGolden = testGroup "golden tests" - . fmap (asGolden (format $ defPrettyConfigPlcClassic defPrettyConfigPlcOptions)) + . fmap (asGolden (format (prettyConfigPlcClassicSimple prettyConfigPlcOptions))) testsRewrite :: [FilePath] -> TestTree testsRewrite = testGroup "golden rewrite tests" - . fmap (asGolden (format $ debugPrettyConfigPlcClassic defPrettyConfigPlcOptions)) + . fmap (asGolden (format (prettyConfigPlcClassic prettyConfigPlcOptions))) tests :: TestTree tests = @@ -311,7 +311,7 @@ tests = where fmt :: T.Text -> Either ParserErrorBundle T.Text fmt = format cfg - cfg = defPrettyConfigPlcClassic defPrettyConfigPlcOptions + cfg = prettyConfigPlcClassicSimple prettyConfigPlcOptions allTests :: [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> TestTree allTests plcFiles rwFiles typeFiles typeErrorFiles = diff --git a/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs b/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs index b07512262cc..f9f5794ec4b 100644 --- a/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs +++ b/plutus-core/plutus-core/test/TypeSynthesis/Spec.hs @@ -59,7 +59,8 @@ assertIllTyped semvar term isExpected = case runExcept . runQuoteT $ typecheck s nestedGoldenVsErrorOrThing :: (PrettyPlc e, PrettyReadable a) => String -> Either e a -> TestNested nestedGoldenVsErrorOrThing name = - nestedGoldenVsText name ".plc" . either displayPlcCondensedErrorClassic (display . AsReadable) + nestedGoldenVsText name ".plc" + . either displayPlcCondensedErrorClassic (render . prettyPlcReadableSimple . AsReadable) foldAssertWell :: (ToBuiltinMeaning DefaultUni fun, Pretty fun) @@ -74,10 +75,12 @@ foldAssertWell semvar test_typecheckAvailable :: TestTree test_typecheckAvailable = - testGroup "Available" - [ foldAssertWell def stdLib - , foldAssertWell def examples - ] + let builtinSemanticsVariant :: ToBuiltinMeaning DefaultUni fun => BuiltinSemanticsVariant fun + builtinSemanticsVariant = def + in testGroup "Available" + [ foldAssertWell builtinSemanticsVariant stdLib + , foldAssertWell builtinSemanticsVariant examples + ] -- | Self-application. An example of ill-typed term. -- diff --git a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Error.hs b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Error.hs index 8193ce53c58..6e23e14abe7 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Compiler/Error.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Compiler/Error.hs @@ -31,7 +31,7 @@ instance PLC.AsTypeError (Error uni fun ann) (PLC.Term PLC.TyName PLC.Name uni f _TypeError = _PLCError . PLC._TypeError instance (PLC.PrettyUni uni, PP.Pretty fun, PP.Pretty ann) => Show (Error uni fun ann) where - show = show . PLC.prettyPlcClassicDebug + show = show . PLC.prettyPlcClassicSimple instance (PLC.PrettyUni uni, PP.Pretty fun, PP.Pretty ann) => PLC.PrettyBy PLC.PrettyConfigPlc (Error uni fun ann) where diff --git a/plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty.hs b/plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty.hs index e0feee60dfa..0de4ecb6fcd 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty.hs @@ -138,21 +138,21 @@ instance ( PLC.PrettyClassicBy configName tyname instance (PLC.PrettyClassic tyname, Pretty ann) => Pretty (TyVarDecl tyname ann) where - pretty = PLC.prettyClassicDef + pretty = PLC.prettyClassic instance ( PLC.PrettyClassic tyname , PLC.PrettyClassic name , PLC.PrettyParens (PLC.SomeTypeIn uni) , Pretty ann ) => Pretty (VarDecl tyname name uni ann) where - pretty = PLC.prettyClassicDef + pretty = PLC.prettyClassic instance ( PLC.PrettyClassic tyname , PLC.PrettyClassic name , PLC.PrettyUni uni , Pretty ann ) => Pretty (Datatype tyname name uni ann) where - pretty = PLC.prettyClassicDef + pretty = PLC.prettyClassic instance ( PLC.PrettyClassic tyname , PLC.PrettyClassic name @@ -160,7 +160,7 @@ instance ( PLC.PrettyClassic tyname , Pretty fun , Pretty ann ) => Pretty (Binding tyname name uni fun ann) where - pretty = PLC.prettyClassicDef + pretty = PLC.prettyClassic instance ( PLC.PrettyClassic tyname , PLC.PrettyClassic name @@ -168,7 +168,7 @@ instance ( PLC.PrettyClassic tyname , Pretty fun , Pretty ann ) => Pretty (Term tyname name uni fun ann) where - pretty = PLC.prettyClassicDef + pretty = PLC.prettyClassic instance ( PLC.PrettyClassic tyname , PLC.PrettyClassic name @@ -176,7 +176,7 @@ instance ( PLC.PrettyClassic tyname , Pretty fun , Pretty ann ) => Pretty (Program tyname name uni fun ann) where - pretty = PLC.prettyClassicDef + pretty = PLC.prettyClassic deriving via PrettyAny (Term tyname name uni fun ann) diff --git a/plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty/Readable.hs b/plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty/Readable.hs index bb35473ab45..120e404c794 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty/Readable.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty/Readable.hs @@ -3,15 +3,17 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} +{-# HLINT ignore "Eta reduce" #-} -- breaks type inference + module PlutusIR.Core.Instance.Pretty.Readable ( prettyPirReadable + , prettyPirReadableSimple , PrettyPir ) where @@ -27,10 +29,11 @@ type PrettyPir = PrettyBy (PrettyConfigReadable PrettyConfigName) -- | Pretty-print something with the @PrettyConfigReadable@ config. prettyPirReadable :: PrettyPir a => a -> Doc ann -prettyPirReadable = prettyBy prettyConfigReadable - -- Using 'debugPrettyConfigName', because it's actually helpful unlike 'defPrettyConfigName'. - where - prettyConfigReadable = botPrettyConfigReadable debugPrettyConfigName def +prettyPirReadable = prettyBy (botPrettyConfigReadable prettyConfigName def) + +-- | Pretty-print something with the @PrettyConfigReadableSimple@ config. +prettyPirReadableSimple :: PrettyPir a => a -> Doc ann +prettyPirReadableSimple = prettyBy (botPrettyConfigReadable prettyConfigNameSimple def) -- | Split an iterated 'LamAbs' (if any) into a list of variables that it binds and its body. viewLamAbs diff --git a/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs b/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs index 832cc50c6a5..88835d4d6e5 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs @@ -1,4 +1,3 @@ --- editorconfig-checker-disable-file {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -7,30 +6,30 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -module PlutusIR.Core.Type ( - TyName (..), - Name (..), - VarDecl (..), - TyVarDecl (..), - varDeclNameString, - tyVarDeclNameString, - Kind (..), - Type (..), - Datatype (..), - datatypeNameString, - Recursivity (..), - Strictness (..), - Binding (..), - Term (..), - Program (..), - Version (..), - applyProgram, - termAnn, - bindingAnn, - progAnn, - progVersion, - progTerm, - ) where +module PlutusIR.Core.Type + ( TyName (..) + , Name (..) + , VarDecl (..) + , TyVarDecl (..) + , varDeclNameString + , tyVarDeclNameString + , Kind (..) + , Type (..) + , Datatype (..) + , datatypeNameString + , Recursivity (..) + , Strictness (..) + , Binding (..) + , Term (..) + , Program (..) + , Version (..) + , applyProgram + , termAnn + , bindingAnn + , progAnn + , progVersion + , progTerm + ) where import PlutusCore (Kind, Name, TyName, Type (..), Version (..)) import PlutusCore qualified as PLC @@ -53,8 +52,9 @@ import PlutusCore.Error (ApplyProgramError (MkApplyProgramError)) -- Datatypes -data Datatype tyname name uni a = Datatype a (TyVarDecl tyname a) [TyVarDecl tyname a] name [VarDecl tyname name uni a] - deriving stock (Functor, Show, Generic) +data Datatype tyname name uni a + = Datatype a (TyVarDecl tyname a) [TyVarDecl tyname a] name [VarDecl tyname name uni a] + deriving stock (Functor, Show, Generic) varDeclNameString :: VarDecl tyname Name uni a -> String varDeclNameString = T.unpack . PLC._nameText . _varDeclName @@ -67,31 +67,44 @@ datatypeNameString (Datatype _ tn _ _ _) = tyVarDeclNameString tn -- Bindings --- | Each multi-let-group has to be marked with its scoping: --- * 'NonRec': the identifiers introduced by this multi-let are only linearly-scoped, i.e. an identifier cannot refer to itself or later-introduced identifiers of the group. --- * 'Rec': an identifiers introduced by this multi-let group can use all other multi-lets of the same group (including itself), --- thus permitting (mutual) recursion. +{- | Each multi-let-group has to be marked with its scoping: +* 'NonRec': the identifiers introduced by this multi-let are only linearly-scoped, + i.e. an identifier cannot refer to itself or later-introduced identifiers of the group. +* 'Rec': an identifiers introduced by this multi-let group can use all other multi-lets + of the same group (including itself), thus permitting (mutual) recursion. +-} data Recursivity = NonRec | Rec - deriving stock (Show, Eq, Generic, Ord) - deriving anyclass Hashable + deriving stock (Show, Eq, Generic, Ord) + deriving anyclass (Hashable) --- | Recursivity can form a 'Semigroup' / lattice, where 'NonRec' < 'Rec'. --- The lattice is ordered by "power": a non-recursive binding group can be made recursive and it will still work, but not vice versa. --- The semigroup operation is the "join" of the lattice. +{- | Recursivity can form a 'Semigroup' / lattice, where 'NonRec' < 'Rec'. +The lattice is ordered by "power": a non-recursive binding group can be made recursive +and it will still work, but not vice versa. +The semigroup operation is the "join" of the lattice. +-} instance Semigroup Recursivity where NonRec <> x = x Rec <> _ = Rec data Strictness = NonStrict | Strict - deriving stock (Show, Eq, Generic) - -data Binding tyname name uni fun a = TermBind a Strictness (VarDecl tyname name uni a) (Term tyname name uni fun a) - | TypeBind a (TyVarDecl tyname a) (Type tyname uni a) - | DatatypeBind a (Datatype tyname name uni a) - deriving stock (Functor, Generic) - -deriving stock instance (Show tyname, Show name, GShow uni, Everywhere uni Show, Show fun, Show a, Closed uni) - => Show (Binding tyname name uni fun a) + deriving stock (Show, Eq, Generic) + +data Binding tyname name uni fun a + = TermBind a Strictness (VarDecl tyname name uni a) (Term tyname name uni fun a) + | TypeBind a (TyVarDecl tyname a) (Type tyname uni a) + | DatatypeBind a (Datatype tyname name uni a) + deriving stock (Functor, Generic) + +deriving stock instance + ( Show tyname + , Show name + , Show fun + , Show a + , GShow uni + , Everywhere uni Show + , Closed uni + ) + => Show (Binding tyname name uni fun a) -- Terms @@ -121,104 +134,125 @@ Plutus Core to use reified declarations. -} -- See Note [PIR as a PLC extension] -data Term tyname name uni fun a = - -- Plutus Core (ish) forms, see Note [Declarations in Plutus Core] - Let a Recursivity (NonEmpty (Binding tyname name uni fun a)) (Term tyname name uni fun a) - | Var a name - | TyAbs a tyname (Kind a) (Term tyname name uni fun a) - | LamAbs a name (Type tyname uni a) (Term tyname name uni fun a) - | Apply a (Term tyname name uni fun a) (Term tyname name uni fun a) - | Constant a (PLC.Some (PLC.ValueOf uni)) - | Builtin a fun - | TyInst a (Term tyname name uni fun a) (Type tyname uni a) - | Error a (Type tyname uni a) - | IWrap a (Type tyname uni a) (Type tyname uni a) (Term tyname name uni fun a) - | Unwrap a (Term tyname name uni fun a) - -- See Note [Constr tag type] - | Constr a (Type tyname uni a) Word64 [Term tyname name uni fun a] - | Case a (Type tyname uni a) (Term tyname name uni fun a) [Term tyname name uni fun a] - deriving stock (Functor, Generic) - -deriving stock instance (Show tyname, Show name, GShow uni, Everywhere uni Show, Show fun, Show a, Closed uni) - => Show (Term tyname name uni fun a) +data Term tyname name uni fun a + = -- Plutus Core (ish) forms, see Note [Declarations in Plutus Core] + Let a Recursivity (NonEmpty (Binding tyname name uni fun a)) (Term tyname name uni fun a) + | Var a name + | TyAbs a tyname (Kind a) (Term tyname name uni fun a) + | LamAbs a name (Type tyname uni a) (Term tyname name uni fun a) + | Apply a (Term tyname name uni fun a) (Term tyname name uni fun a) + | Constant a (PLC.Some (PLC.ValueOf uni)) + | Builtin a fun + | TyInst a (Term tyname name uni fun a) (Type tyname uni a) + | Error a (Type tyname uni a) + | IWrap a (Type tyname uni a) (Type tyname uni a) (Term tyname name uni fun a) + | Unwrap a (Term tyname name uni fun a) + | -- See Note [Constr tag type] + Constr a (Type tyname uni a) Word64 [Term tyname name uni fun a] + | Case a (Type tyname uni a) (Term tyname name uni fun a) [Term tyname name uni fun a] + deriving stock (Functor, Generic) + +deriving stock instance + ( Show tyname + , Show name + , GShow uni + , Everywhere uni Show + , Show fun + , Show a + , Closed uni + ) + => Show (Term tyname name uni fun a) -- See Note [ExMemoryUsage instances for non-constants]. instance ExMemoryUsage (Term tyname name uni fun ann) where - memoryUsage = - Prelude.error "Internal error: 'memoryUsage' for IR 'Term' is not supposed to be forced" + memoryUsage = + Prelude.error "Internal error: 'memoryUsage' for IR 'Term' is not supposed to be forced" type instance UniOf (Term tyname name uni fun ann) = uni instance HasConstant (Term tyname name uni fun ()) where - asConstant (Constant _ val) = pure val - asConstant _ = throwNotAConstant + asConstant (Constant _ val) = pure val + asConstant _ = throwNotAConstant - fromConstant = Constant () + fromConstant = Constant () instance TermLike (Term tyname name uni fun) tyname name uni fun where - var = Var - tyAbs = TyAbs - lamAbs = LamAbs - apply = Apply - constant = Constant - builtin = Builtin - tyInst = TyInst - unwrap = Unwrap - iWrap = IWrap - error = Error - constr = Constr - kase = Case - - termLet x (Def vd bind) = Let x NonRec (pure $ TermBind x Strict vd bind) - typeLet x (Def vd bind) = Let x NonRec (pure $ TypeBind x vd bind) + var = Var + tyAbs = TyAbs + lamAbs = LamAbs + apply = Apply + constant = Constant + builtin = Builtin + tyInst = TyInst + unwrap = Unwrap + iWrap = IWrap + error = Error + constr = Constr + kase = Case + + termLet x (Def vd bind) = Let x NonRec (pure $ TermBind x Strict vd bind) + typeLet x (Def vd bind) = Let x NonRec (pure $ TypeBind x vd bind) data Program tyname name uni fun ann = Program - { _progAnn :: ann - -- | The version of the program. This corresponds to the underlying - -- Plutus Core version. - , _progVersion :: Version - , _progTerm :: Term tyname name uni fun ann - } - deriving stock (Functor, Generic) + { _progAnn :: ann + , _progVersion :: Version + -- ^ The version of the program. This corresponds to the underlying Plutus Core version. + , _progTerm :: Term tyname name uni fun ann + } + deriving stock (Functor, Generic) makeLenses ''Program -deriving stock instance (Show tyname, Show name, GShow uni, Everywhere uni Show, Show fun, Show ann, Closed uni) - => Show (Program tyname name uni fun ann) - - -type instance PLC.HasUniques (Term tyname name uni fun ann) = (PLC.HasUnique tyname PLC.TypeUnique, PLC.HasUnique name PLC.TermUnique) -type instance PLC.HasUniques (Program tyname name uni fun ann) = PLC.HasUniques (Term tyname name uni fun ann) - --- | Applies one program to another. Fails if the versions do not match --- and tries to merge annotations. +deriving stock instance + ( Show tyname + , Show name + , GShow uni + , Everywhere uni Show + , Show fun + , Show ann + , Closed uni + ) + => Show (Program tyname name uni fun ann) + +type instance + PLC.HasUniques (Term tyname name uni fun ann) = + (PLC.HasUnique tyname PLC.TypeUnique, PLC.HasUnique name PLC.TermUnique) + +type instance + PLC.HasUniques (Program tyname name uni fun ann) = + PLC.HasUniques (Term tyname name uni fun ann) + +{- | Applies one program to another. Fails if the versions do not match +and tries to merge annotations. +-} applyProgram - :: (MonadError ApplyProgramError m, Semigroup a) - => Program tyname name uni fun a - -> Program tyname name uni fun a - -> m (Program tyname name uni fun a) -applyProgram (Program a1 v1 t1) (Program a2 v2 t2) | v1 == v2 - = pure $ Program (a1 <> a2) v1 (Apply (termAnn t1 <> termAnn t2) t1 t2) + :: (MonadError ApplyProgramError m, Semigroup a) + => Program tyname name uni fun a + -> Program tyname name uni fun a + -> m (Program tyname name uni fun a) +applyProgram (Program a1 v1 t1) (Program a2 v2 t2) + | v1 == v2 = + pure $ Program (a1 <> a2) v1 (Apply (termAnn t1 <> termAnn t2) t1 t2) applyProgram (Program _a1 v1 _t1) (Program _a2 v2 _t2) = - throwError $ MkApplyProgramError v1 v2 + throwError $ MkApplyProgramError v1 v2 termAnn :: Term tyname name uni fun a -> a termAnn = \case - Let a _ _ _ -> a - Var a _ -> a - TyAbs a _ _ _ -> a - LamAbs a _ _ _ -> a - Apply a _ _ -> a - Constant a _ -> a - Builtin a _ -> a - TyInst a _ _ -> a - Error a _ -> a - IWrap a _ _ _ -> a - Unwrap a _ -> a - Constr a _ _ _ -> a - Case a _ _ _ -> a + Let a _ _ _ -> a + Var a _ -> a + TyAbs a _ _ _ -> a + LamAbs a _ _ _ -> a + Apply a _ _ -> a + Constant a _ -> a + Builtin a _ -> a + TyInst a _ _ -> a + Error a _ -> a + IWrap a _ _ _ -> a + Unwrap a _ -> a + Constr a _ _ _ -> a + Case a _ _ _ -> a bindingAnn :: Binding tyname name uni fun a -> a bindingAnn = \case - TermBind a _ _ _ -> a - TypeBind a _ _ -> a - DatatypeBind a _ -> a + TermBind a _ _ _ -> a + TypeBind a _ _ -> a + DatatypeBind a _ -> a diff --git a/plutus-core/plutus-ir/src/PlutusIR/Error.hs b/plutus-core/plutus-ir/src/PlutusIR/Error.hs index e02a053dfa9..8ecf4d19e09 100644 --- a/plutus-core/plutus-ir/src/PlutusIR/Error.hs +++ b/plutus-core/plutus-ir/src/PlutusIR/Error.hs @@ -79,7 +79,7 @@ deriving anyclass instance (PLC.ThrowableBuiltins uni fun, PP.Pretty ann, Typeable ann) => Exception (Error uni fun ann) instance (PLC.PrettyUni uni, Pretty fun, Pretty ann) => Pretty (Error uni fun ann) where - pretty = PLC.prettyPlcClassicDef + pretty = PLC.prettyPlcClassic instance (PLC.PrettyUni uni, Pretty fun, Pretty ann) => diff --git a/plutus-core/plutus-ir/test/PlutusIR/Analysis/RetainedSize/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Analysis/RetainedSize/Tests.hs index f7d91041b37..d112a7149bf 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Analysis/RetainedSize/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Analysis/RetainedSize/Tests.hs @@ -16,7 +16,7 @@ test_retainedSize :: TestTree test_retainedSize = runTestNested ["plutus-ir", "test", "PlutusIR", "Analysis", "RetainedSize"] $ map - (goldenPir renameAndAnnotate pTerm) + (goldenPirUnique renameAndAnnotate pTerm) [ "typeLet" , "termLet" , "strictLet" @@ -38,7 +38,7 @@ test_retainedSize = , "recBindingComplex" ] where - displayAnnsConfig = PLC.PrettyConfigClassic PLC.defPrettyConfigName True + displayAnnsConfig = PLC.PrettyConfigClassic PLC.prettyConfigNameSimple True renameAndAnnotate = PLC.AttachPrettyConfig displayAnnsConfig . RetainedSize.annotateWithRetainedSize def diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs index 4f4275370d1..6d7611cdc3d 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs @@ -25,7 +25,7 @@ test_prettyprintingReadable :: TestTree test_prettyprintingReadable = runTestNested ["plutus-ir", "test", "PlutusIR", "Core", "prettyprintingReadable"] $ map - (goldenPirDoc prettyPirReadable pTerm) + (goldenPirDoc prettyPirReadableSimple pTerm) [ "basic" , "maybe" , "letInLet" diff --git a/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs index be9afe4f5f1..bc4038a13dd 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Parser/Tests.hs @@ -53,24 +53,30 @@ separator :: Char -> Bool separator c = c `elem` separators || isSpace c aroundSeparators :: MonadGen m => m String -> String -> m String -aroundSeparators = go False +aroundSeparators = go False False where -- Quoted names may contain separators, but they are part of the name, so -- we cannot scramble inside quoted names. - go inQuotedName splice = \case + go inQuotedName inUnique splice = \case [] -> pure [] [s] -> (s:) <$> splice + ('`' : '-' : l) | inQuotedName -> do + let (digits, notDigits) = break isDigit l + rest <- go (not inQuotedName) True splice notDigits + pure $ "`-" ++ digits ++ rest ('`' : l) -> do s <- splice - rest <- go (not inQuotedName) splice l - pure $ if inQuotedName then '`' : s ++ rest else s ++ '`' : rest + rest <- go (not inQuotedName) inUnique splice l + pure $ if inQuotedName + then '`' : s ++ rest + else s ++ '`' : rest (a : b : l) - | not (inQuotedName) && separator b -> do + | not inQuotedName && separator b -> do s1 <- splice s2 <- splice - rest <- go inQuotedName splice l + rest <- go inQuotedName inUnique splice l pure $ a : s1 ++ b : s2 ++ rest - | otherwise -> (a :) <$> go inQuotedName splice (b : l) + | otherwise -> (a :) <$> go inQuotedName inUnique splice (b : l) genScrambledWith :: MonadGen m => m String -> m (String, String) genScrambledWith splice = do @@ -118,8 +124,8 @@ propIgnores splice = property $ do (original, scrambled) <- forAll (genScrambledWith splice) let displayProgram :: Program TyName Name PLC.DefaultUni PLC.DefaultFun SrcSpan -> String displayProgram = display - parse1 = displayProgram <$> (parseProg $ T.pack original) - parse2 = displayProgram <$> (parseProg $ T.pack scrambled) + parse1 = displayProgram <$> parseProg (T.pack original) + parse2 = displayProgram <$> parseProg (T.pack scrambled) parse1 === parse2 test_parsing :: TestTree diff --git a/plutus-core/plutus-ir/test/PlutusIR/Purity/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Purity/Tests.hs index e947317a266..7593c086972 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Purity/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Purity/Tests.hs @@ -1,11 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} module PlutusIR.Purity.Tests where import Test.Tasty.Extras import PlutusCore qualified as PLC -import PlutusCore.Pretty (prettyPlcReadableDef) +import PlutusCore.Pretty (prettyPlcReadable) import PlutusCore.Quote import PlutusIR import PlutusIR.Analysis.VarInfo @@ -29,7 +28,7 @@ computeEvalOrderCoarse computeEvalOrderCoarse = termEvaluationOrder def mempty goldenEvalOrder :: String -> TestNested -goldenEvalOrder = goldenPirDoc (prettyPlcReadableDef . computeEvalOrder) pTerm +goldenEvalOrder = goldenPirDoc (prettyPlcReadable . computeEvalOrder) pTerm -- Should hit Unknown before trying to process the undefined. Shows -- that the computation is lazy diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs index da91258a806..b6520a69bfd 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/Tests.hs @@ -41,8 +41,7 @@ test_evaluateBuiltins = , "uncompressAndEqualBlsNonConservative" ] -prop_evaluateBuiltins :: - Bool -> BuiltinSemanticsVariant DefaultFun -> Property +prop_evaluateBuiltins :: Bool -> BuiltinSemanticsVariant DefaultFun -> Property prop_evaluateBuiltins conservative biVariant = withMaxSuccess (2 * 3 * numTestsForPassProp) $ testPassProp diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/Tests.hs index c767ecf4cca..baa43be5eb7 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/Tests.hs @@ -3,7 +3,6 @@ module PlutusIR.Transform.Rename.Tests where import Test.Tasty import Test.Tasty.Extras -import PlutusCore.Pretty qualified as PLC import PlutusCore.Quote import PlutusIR.Parser import PlutusIR.Pass @@ -14,17 +13,16 @@ import Test.Tasty.QuickCheck test_rename :: TestTree test_rename = + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "Rename"] $ - map - (goldenPir - (PLC.AttachPrettyConfig debugConfig . runQuote . runTestPass (const renamePass)) pTerm) - [ "allShadowedDataNonRec" - , "allShadowedDataRec" - , "paramShadowedDataNonRec" - , "paramShadowedDataRec" - ] + runGoldenPir <$> + [ "allShadowedDataNonRec" + , "allShadowedDataRec" + , "paramShadowedDataNonRec" + , "paramShadowedDataRec" + ] where - debugConfig = PLC.PrettyConfigClassic PLC.debugPrettyConfigName False + runGoldenPir = goldenPir (runQuote . runTestPass (const renamePass)) pTerm prop_rename :: Property prop_rename = diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs index a4afde2d2fc..f839c8db161 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/Tests.hs @@ -14,28 +14,25 @@ import Test.Tasty test_rewriteRules :: TestTree test_rewriteRules = - runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "RewriteRules"] $ - (fmap - (goldenPir (runQuote . runTestPass (\tc -> rewritePassSC tc def)) pTerm) - [ "equalsInt.pir" -- this tests that the function works on equalInteger - , "divideInt.pir" -- this tests that the function excludes not commutative functions - , "multiplyInt.pir" -- this tests that the function works on multiplyInteger - , "let.pir" -- this tests that it works in the subterms - , "unConstrConstrDataFst.pir" - , "unConstrConstrDataSnd.pir" - ] - ) - ++ - (fmap - (goldenPirEvalTrace pTermAsProg) - [ "unConstrConstrDataFst.pir.eval" - ] - ) + runTestNested ["plutus-ir", "test", "PlutusIR", "Transform", "RewriteRules"] $ + fmap + (goldenPir (runQuote . runTestPass (\tc -> rewritePassSC tc def)) pTerm) + [ "equalsInt.pir" -- this tests that the function works on equalInteger + , "divideInt.pir" -- this tests that the function excludes not commutative functions + , "multiplyInt.pir" -- this tests that the function works on multiplyInteger + , "let.pir" -- this tests that it works in the subterms + , "unConstrConstrDataFst.pir" + , "unConstrConstrDataSnd.pir" + ] + ++ fmap + (goldenPirEvalTrace pTermAsProg) + [ "unConstrConstrDataFst.pir.eval" + ] where - goldenPirEvalTrace = goldenPirM $ \ast -> ppCatch $ do - -- we need traces to remain for checking the evaluation-order - tplc <- asIfThrown $ compileWithOpts ( set (PIR.ccOpts . PIR.coPreserveLogging) True) ast - runUPlcLogs [void tplc] + goldenPirEvalTrace = goldenPirM $ \ast -> ppCatch prettyPlcClassicSimple $ do + -- we need traces to remain for checking the evaluation-order + tplc <- asIfThrown $ compileWithOpts (set (PIR.ccOpts . PIR.coPreserveLogging) True) ast + runUPlcLogs [void tplc] prop_rewriteRules :: Property prop_rewriteRules = diff --git a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Test.hs b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Test.hs index ab045c191d2..97339b2e8cb 100644 --- a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Test.hs +++ b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Test.hs @@ -67,9 +67,9 @@ printSampleProgramAndValue => TermGen a -> IO () printSampleProgramAndValue = getSampleProgramAndValue >=> \(program, value) -> do - putStrLn $ displayPlcDef program + putStrLn $ displayPlc program putStrLn "" - putStrLn $ displayPlcDef value + putStrLn $ displayPlc value -- | Generate a pair of files: @..plc@ and @..plc.golden@. -- The first file contains a term generated by a term generator (wrapped in 'Program'), @@ -86,8 +86,8 @@ sampleProgramValueGolden folder name genTerm = do let filePlc = folder (name ++ ".plc") filePlcGolden = folder (name ++ ".plc.golden") (program, value) <- getSampleProgramAndValue genTerm - Text.writeFile filePlc $ displayPlcDef program - Text.writeFile filePlcGolden $ displayPlcDef value + Text.writeFile filePlc $ displayPlc program + Text.writeFile filePlcGolden $ displayPlc value -- | A property-based testing procedure for evaluators. -- Checks whether a term generated along with the value it's supposed to compute to diff --git a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/TypeEvalCheck.hs b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/TypeEvalCheck.hs index 2df1a45e66d..cd9cad55e80 100644 --- a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/TypeEvalCheck.hs +++ b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/TypeEvalCheck.hs @@ -132,6 +132,6 @@ unsafeTypeEvalCheck termOfTbv = do Left err -> error $ concat [ prettyPlcErrorString err , "\nin\n" - , render . prettyPlcClassicDebug $ _termOfTerm termOfTbv + , render . prettyPlcClassicSimple $ _termOfTerm termOfTbv ] Right termOfTecr -> _termCheckResultValue <$> termOfTecr diff --git a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Utils.hs b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Utils.hs index 1730380b9ec..c5b759791e6 100644 --- a/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Utils.hs +++ b/plutus-core/testlib/PlutusCore/Generators/Hedgehog/Utils.hs @@ -64,13 +64,13 @@ forAllPrettyT = forAllWithT display -- | Generate a value using the 'PrettyPlc' constraint for getting its 'String' representation. forAllPrettyPlc :: (Monad m, PrettyPlc a) => Gen a -> PropertyT m a -forAllPrettyPlc = forAllWith displayPlcDef +forAllPrettyPlc = forAllWith displayPlc -- | Generate a value using the 'PrettyPlc' constraint for getting its 'String' representation. -- A supplied generator has access to the 'Monad' the whole property has access to. forAllPrettyPlcT :: (Monad m, PrettyPlc a) => GenT m a -> PropertyT m a -forAllPrettyPlcT = forAllWithT displayPlcDef +forAllPrettyPlcT = forAllWithT displayPlc -- | Pretty-print a PLC error. prettyPlcErrorString :: PrettyPlc err => err -> String -prettyPlcErrorString = render . prettyPlcCondensedErrorBy debugPrettyConfigPlcClassic +prettyPlcErrorString = render . prettyPlcCondensedErrorBy prettyConfigPlcClassicSimple diff --git a/plutus-core/testlib/PlutusCore/Test.hs b/plutus-core/testlib/PlutusCore/Test.hs index 2aee9675ee1..ec8b80b89f9 100644 --- a/plutus-core/testlib/PlutusCore/Test.hs +++ b/plutus-core/testlib/PlutusCore/Test.hs @@ -91,6 +91,7 @@ import Hedgehog.Internal.Property import Hedgehog.Internal.Region import Hedgehog.Internal.Report import Hedgehog.Internal.Runner +import PlutusCore.Pretty qualified as PP -- | Map the 'TestLimit' of a 'Property' with a given function. mapTestLimit :: (TestLimit -> TestLimit) -> Property -> Property @@ -210,7 +211,7 @@ instance (PrettyBy config err) instance (PrettyPlc err) => Show (EvaluationExceptionWithLogsAndBudget err) where - show = render . prettyPlcReadableDebug + show = render . prettyPlcReadableSimple instance (PrettyPlc err, Exception err) => Exception (EvaluationExceptionWithLogsAndBudget err) @@ -301,14 +302,19 @@ runUPlcProfile' values = do Right _ -> pure logs ppCatch :: (PrettyPlc a) => ExceptT SomeException IO a -> IO (Doc ann) -ppCatch value = either (PP.pretty . show) prettyPlcClassicDebug <$> runExceptT value +ppCatch value = either (PP.prettyClassic . show) prettyPlcReadableSimple <$> runExceptT value ppCatch' :: ExceptT SomeException IO (Doc ann) -> IO (Doc ann) -ppCatch' value = either (PP.pretty . show) id <$> runExceptT value +ppCatch' value = either (PP.prettyClassic . show) id <$> runExceptT value -ppCatchReadable :: (PrettyBy (PrettyConfigReadable PrettyConfigName) a) +ppCatchReadable + :: forall a ann + . PrettyBy (PrettyConfigReadable PrettyConfigName) a => ExceptT SomeException IO a -> IO (Doc ann) -ppCatchReadable value = either (PP.pretty . show) (pretty . AsReadable) <$> runExceptT value +ppCatchReadable value = + let pprint :: forall t. PrettyBy (PrettyConfigReadable PrettyConfigName) t => t -> Doc ann + pprint = prettyBy (topPrettyConfigReadable prettyConfigNameSimple def) + in either (pprint . show) pprint <$> runExceptT value goldenTPlcWith :: (ToTPlc a TPLC.DefaultUni TPLC.DefaultFun) => @@ -376,58 +382,29 @@ goldenTEval :: goldenTEval name values = nestedGoldenVsDocM name ".eval" $ ppCatch $ runTPlc values -goldenUEval :: - (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => - String -> - [a] -> - TestNested -goldenUEval name values = - nestedGoldenVsDocM name ".eval" $ ppCatch $ runUPlc values +goldenUEval :: (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => String -> [a] -> TestNested +goldenUEval name values = nestedGoldenVsDocM name ".eval" $ ppCatch $ runUPlc values -goldenUEvalLogs :: - (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => - String -> - [a] -> - TestNested -goldenUEvalLogs name values = - nestedGoldenVsDocM name ".eval" $ ppCatch $ runUPlcLogs values +goldenUEvalLogs :: (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => String -> [a] -> TestNested +goldenUEvalLogs name values = nestedGoldenVsDocM name ".eval" $ ppCatch $ runUPlcLogs values -- | This is mostly useful for profiling a test that is normally -- tested with one of the other functions, as it's a drop-in -- replacement and you can then pass the output into `traceToStacks`. -goldenUEvalProfile :: - (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => - String -> - [a] -> - TestNested -goldenUEvalProfile name values = - nestedGoldenVsDocM name ".eval" $ ppCatch $ runUPlcProfile values - -goldenUEvalBudget :: - (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) - => String - -> [a] - -> TestNested -goldenUEvalBudget name values = - nestedGoldenVsDocM name ".budget" $ ppCatch $ runUPlcBudget values - -goldenSize :: - (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => - String -> - a -> - TestNested +goldenUEvalProfile :: (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => String -> [a] -> TestNested +goldenUEvalProfile name values = nestedGoldenVsDocM name ".eval" $ ppCatch $ runUPlcProfile values + +goldenUEvalBudget :: (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => String -> [a] -> TestNested +goldenUEvalBudget name values = nestedGoldenVsDocM name ".budget" $ ppCatch $ runUPlcBudget values + +goldenSize :: (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => String -> a -> TestNested goldenSize name value = - nestedGoldenVsDocM name ".size" $ - pure . pretty . UPLC.programSize =<< rethrow (toUPlc value) + nestedGoldenVsDocM name ".size" $ pure . pretty . UPLC.programSize =<< rethrow (toUPlc value) -- | This is mostly useful for profiling a test that is normally -- tested with one of the other functions, as it's a drop-in -- replacement and you can then pass the output into `traceToStacks`. -goldenUEvalProfile' :: - (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => - String -> - [a] -> - TestNested +goldenUEvalProfile' :: (ToUPlc a TPLC.DefaultUni TPLC.DefaultFun) => String -> [a] -> TestNested goldenUEvalProfile' name values = nestedGoldenVsDocM name ".eval" $ ppCatch' $ fmap (\ts -> PP.vsep (fmap pretty ts)) $ runUPlcProfile' values @@ -597,7 +574,7 @@ prop_scopingFor gen bindRem preren run = withTests 1000 . property $ do prep = runPrerename preren case catchEverything $ checkRespectsScoping bindRem prep (TPLC.runQuote . run) prog of Left exc -> fail $ displayException exc - Right (Left err) -> fail $ displayPlcDef err + Right (Left err) -> fail $ displayPlc err Right (Right ()) -> success -- | Test that a pass does not break global uniqueness. diff --git a/plutus-core/testlib/PlutusIR/Generators/QuickCheck/ShrinkTerms.hs b/plutus-core/testlib/PlutusIR/Generators/QuickCheck/ShrinkTerms.hs index 66678185e66..7039702c7a8 100644 --- a/plutus-core/testlib/PlutusIR/Generators/QuickCheck/ShrinkTerms.hs +++ b/plutus-core/testlib/PlutusIR/Generators/QuickCheck/ShrinkTerms.hs @@ -346,7 +346,7 @@ shrinkTypedTerm tyctx0 ctx0 (ty0, tm0) = concat fun' = fixupTerm tyctx ctx tyctx ctx (TyForall () x k' tyInner') fun ] Left err -> error $ displayPlcCondensedErrorClassic err - Right tyWrong -> error $ "Expected a 'TyForall', but got " ++ displayPlcDef tyWrong + Right tyWrong -> error $ "Expected a 'TyForall', but got " ++ displayPlc tyWrong -- TODO: shrink the kind too like with the type in @LamAbs@ below. TyAbs _ x _ body | not $ Map.member x tyctx -> diff --git a/plutus-core/testlib/PlutusIR/Test.hs b/plutus-core/testlib/PlutusIR/Test.hs index b7422409eb3..5039b25f577 100644 --- a/plutus-core/testlib/PlutusIR/Test.hs +++ b/plutus-core/testlib/PlutusIR/Test.hs @@ -12,7 +12,7 @@ module PlutusIR.Test , initialSrcSpan , topSrcSpan , rethrow - , PLC.prettyPlcClassicDebug + , PLC.prettyPlcClassicSimple ) where import PlutusPrelude @@ -24,13 +24,17 @@ import Control.Monad.Except import Control.Monad.Morph (hoist) import Control.Monad.Reader as Reader -import PlutusCore qualified as PLC +import PlutusCore.Annotation qualified as PLC import PlutusCore.Builtin qualified as PLC +import PlutusCore.Core qualified as PLC +import PlutusCore.DeBruijn qualified as PLC +import PlutusCore.Default qualified as PLC import PlutusCore.Error (ParserErrorBundle) import PlutusCore.Pretty import PlutusCore.Pretty qualified as PLC import PlutusCore.Quote (runQuoteT) import PlutusCore.Test hiding (ppCatch) +import PlutusCore.TypeCheck qualified as PLC import PlutusIR as PIR import PlutusIR.Analysis.Builtins import PlutusIR.Compiler as PIR @@ -129,35 +133,36 @@ withGoldenFileM name op = do where currentDir = joinPath <$> ask --- TODO: deduplicate with the PlutusuCore one -ppCatch :: (PrettyPlc a) => ExceptT SomeException IO a -> IO T.Text -ppCatch value = render <$> (either (pretty . show) prettyPlcClassicDebug <$> runExceptT value) +-- TODO: deduplicate with the Plutus Core one +ppCatch :: (a -> Doc ann) -> ExceptT SomeException IO a -> IO T.Text +ppCatch toDoc value = render . either (pretty . show) toDoc <$> runExceptT value -goldenPir :: (Pretty b) => (a -> b) -> Parser a -> String -> TestNested +goldenPir :: (PrettyPlc b) => (a -> b) -> Parser a -> String -> TestNested goldenPir op = goldenPirM (return . op) +goldenPirUnique :: (Pretty b) => (a -> b) -> Parser a -> String -> TestNested +goldenPirUnique op = goldenPirMUnique (return . op) + goldenPirDoc :: (a -> Doc ann) -> Parser a -> String -> TestNested goldenPirDoc op = goldenPirDocM (return . op) -goldenPirM :: forall a b. (Pretty b) => (a -> IO b) -> Parser a -> String -> TestNested -goldenPirM op parser name = withGoldenFileM name parseOrError +goldenPirMUnique :: forall a b. (Pretty b) => (a -> IO b) -> Parser a -> String -> TestNested +goldenPirMUnique op parser name = withGoldenFileM name parseOrError where parseOrError :: T.Text -> IO T.Text parseOrError = let parseTxt :: T.Text -> Either ParserErrorBundle a parseTxt txt = runQuoteT $ parse parser name txt - in either (return . display) (fmap display . op) - . parseTxt + in either (return . display) (fmap display . op) . parseTxt -goldenPirMUnique :: forall a b. (PrettyPlc b) => (a -> IO b) -> Parser a -> String -> TestNested -goldenPirMUnique op parser name = withGoldenFileM name parseOrError +goldenPirM :: forall a b. (PrettyPlc b) => (a -> IO b) -> Parser a -> String -> TestNested +goldenPirM op parser name = withGoldenFileM name parseOrError where parseOrError :: T.Text -> IO T.Text parseOrError = let parseTxt :: T.Text -> Either ParserErrorBundle a parseTxt txt = runQuoteT $ parse parser name txt - in either (return . display) (fmap (render . prettyPlcReadableDef) . op) - . parseTxt + in either (pure . display) ((render . prettyPlcReadableSimple <$>) . op) . parseTxt goldenPirDocM :: forall a ann. (a -> IO (Doc ann)) -> Parser a -> String -> TestNested goldenPirDocM op parser name = withGoldenFileM name parseOrError @@ -174,7 +179,7 @@ goldenPlcFromPir :: Parser a -> String -> TestNested -goldenPlcFromPir = goldenPirM $ \ast -> ppCatch $ do +goldenPlcFromPir = goldenPirM $ \ast -> ppCatch prettyPlcReadableSimple $ do p <- toTPlc ast withExceptT @_ @PLC.FreeVariableError toException $ traverseOf PLC.progTerm PLC.deBruijnTerm p @@ -184,7 +189,7 @@ goldenPlcFromPirScott :: Parser prog -> String -> TestNested -goldenPlcFromPirScott = goldenPirM $ \ast -> ppCatch $ do +goldenPlcFromPirScott = goldenPirM $ \ast -> ppCatch prettyPlcReadableSimple $ do p <- asIfThrown . fmap void @@ -197,14 +202,14 @@ goldenNamedUPlcFromPir :: Parser a -> String -> TestNested -goldenNamedUPlcFromPir = goldenPirM $ ppCatch . toUPlc +goldenNamedUPlcFromPir = goldenPirM $ ppCatch prettyPlcReadableSimple . toUPlc goldenEvalPir :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => Parser a -> String -> TestNested -goldenEvalPir = goldenPirM (\ast -> ppCatch $ runUPlc [ast]) +goldenEvalPir = goldenPirM (\ast -> ppCatch prettyPlcReadableSimple $ runUPlc [ast]) goldenTypeFromPir :: forall a. @@ -214,7 +219,7 @@ goldenTypeFromPir :: String -> TestNested goldenTypeFromPir x = - goldenPirM $ \ast -> ppCatch $ + goldenPirM $ \ast -> ppCatch prettyPlcReadable $ withExceptT (toException :: PIR.Error PLC.DefaultUni PLC.DefaultFun a -> SomeException) $ runQuoteT $ do tcConfig <- getDefTypeCheckConfig x diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Default.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Default.hs index a91cec3d9d6..eac92892320 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Default.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Default.hs @@ -19,8 +19,8 @@ import UntypedPlutusCore.Core.Type instance (PrettyClassic name, PrettyUni uni, Pretty fun, Pretty ann) => Pretty (Term name uni fun ann) where - pretty = prettyClassicDef + pretty = prettyClassic instance (PrettyClassic name, PrettyUni uni, Pretty fun, Pretty ann) => Pretty (Program name uni fun ann) where - pretty = prettyClassicDef + pretty = prettyClassic diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Readable.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Readable.hs index 12b623e1406..681d1c81ea6 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Readable.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Core/Instance/Pretty/Readable.hs @@ -34,7 +34,7 @@ viewApp term0 = go term0 [] where go fun args = Just (fun, args) instance - (PrettyReadableBy configName name, PrettyUni uni, Pretty fun) => + (PrettyReadableBy configName name, PrettyUni uni, Pretty fun, Show configName) => PrettyBy (PrettyConfigReadable configName) (Term name uni fun a) where prettyBy = inContextM $ \case diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/EmitterMode.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/EmitterMode.hs index ea1cccd2fd5..44548468a25 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/EmitterMode.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/EmitterMode.hs @@ -1,8 +1,11 @@ --- editorconfig-checker-disable-file -{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} -module UntypedPlutusCore.Evaluation.Machine.Cek.EmitterMode (noEmitter, logEmitter, logWithTimeEmitter, logWithBudgetEmitter) where +module UntypedPlutusCore.Evaluation.Machine.Cek.EmitterMode + ( noEmitter + , logEmitter + , logWithTimeEmitter + , logWithBudgetEmitter + ) where import UntypedPlutusCore.Evaluation.Machine.Cek.Internal @@ -30,38 +33,38 @@ noEmitter = EmitterMode $ \_ -> pure $ CekEmitterInfo (\_ -> pure ()) (pure memp -- | Emits log only. logEmitter :: EmitterMode uni fun logEmitter = EmitterMode $ \_ -> do - logsRef <- newSTRef DList.empty - let emitter logs = CekM $ modifySTRef logsRef (`DList.append` logs) - pure $ CekEmitterInfo emitter (DList.toList <$> readSTRef logsRef) + logsRef <- newSTRef DList.empty + let emitter logs = CekM $ modifySTRef logsRef (`DList.append` logs) + pure $ CekEmitterInfo emitter (DList.toList <$> readSTRef logsRef) -- A wrapper around encoding a record. `cassava` insists on including a trailing newline, which is -- annoying since we're recording the output line-by-line. -encodeRecord :: CSV.ToRecord a => a -> T.Text +encodeRecord :: (CSV.ToRecord a) => a -> T.Text encodeRecord a = T.stripEnd $ T.decodeUtf8 $ BSL.toStrict $ BS.toLazyByteString $ CSV.encodeRecord a -- | Emits log with timestamp. logWithTimeEmitter :: EmitterMode uni fun logWithTimeEmitter = EmitterMode $ \_ -> do - logsRef <- newSTRef DList.empty - let emitter logs = CekM $ do - time <- unsafeIOToST getCurrentTime - let secs = let MkFixed s = nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds time in s - let withTime = logs <&> \str -> encodeRecord (str, secs) - modifySTRef logsRef (`DList.append` withTime) - pure $ CekEmitterInfo emitter (DList.toList <$> readSTRef logsRef) + logsRef <- newSTRef DList.empty + let emitter logs = CekM $ do + time <- unsafeIOToST getCurrentTime + let secs = let MkFixed s = nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds time in s + let withTime = logs <&> \str -> encodeRecord (str, secs) + modifySTRef logsRef (`DList.append` withTime) + pure $ CekEmitterInfo emitter (DList.toList <$> readSTRef logsRef) instance CSV.ToField ExCPU where - toField (ExCPU t) = CSV.toField $ unSatInt t + toField (ExCPU t) = CSV.toField $ unSatInt t instance CSV.ToField ExMemory where - toField (ExMemory t) = CSV.toField $ unSatInt t + toField (ExMemory t) = CSV.toField $ unSatInt t -- | Emits log with the budget. logWithBudgetEmitter :: EmitterMode uni fun logWithBudgetEmitter = EmitterMode $ \getBudget -> do - logsRef <- newSTRef DList.empty - let emitter logs = CekM $ do - ExBudget exCpu exMemory <- getBudget - let withBudget = logs <&> \str -> encodeRecord (str, exCpu, exMemory) - modifySTRef logsRef (`DList.append` withBudget) - pure $ CekEmitterInfo emitter (DList.toList <$> readSTRef logsRef) + logsRef <- newSTRef DList.empty + let emitter logs = CekM $ do + ExBudget exCpu exMemory <- getBudget + let withBudget = logs <&> \str -> encodeRecord (str, exCpu, exMemory) + modifySTRef logsRef (`DList.append` withBudget) + pure $ CekEmitterInfo emitter (DList.toList <$> readSTRef logsRef) diff --git a/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs b/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs index 78b8efec252..9973f8b95ca 100644 --- a/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs +++ b/plutus-core/untyped-plutus-core/test/Analysis/Spec.hs @@ -6,7 +6,7 @@ import Test.Tasty.Extras import PlutusCore qualified as PLC import PlutusCore.MkPlc -import PlutusCore.Pretty (prettyPlcReadableDef) +import PlutusCore.Pretty (prettyPlcReadable) import PlutusCore.Quote import PlutusPrelude (def) import Test.Tasty @@ -16,7 +16,7 @@ import UntypedPlutusCore.Purity goldenEvalOrder :: String -> Term Name PLC.DefaultUni PLC.DefaultFun () -> TestNested goldenEvalOrder name tm = - nestedGoldenVsDoc name "" (prettyPlcReadableDef $ termEvaluationOrder def tm) + nestedGoldenVsDoc name "" (prettyPlcReadable $ termEvaluationOrder def tm) -- Should hit Unknown before trying to process the undefined. Shows -- that the computation is lazy diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/UnDeBruijnify.hs b/plutus-core/untyped-plutus-core/test/DeBruijn/UnDeBruijnify.hs index 0ea3f7665f7..ae059afc982 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/UnDeBruijnify.hs +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/UnDeBruijnify.hs @@ -83,5 +83,5 @@ test_undebruijnify = testNested "Golden" mkProg = Program () PLC.latestVersion . termMapNames fakeNameDeBruijn - toPretty = prettyPlcClassicDebug . runExcept @(Error DefaultUni DefaultFun ()) . runQuoteT + toPretty = prettyPlcClassicSimple . runExcept @(Error DefaultUni DefaultFun ()) . runQuoteT diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs index fab83cf11a4..f1585551781 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs @@ -417,8 +417,8 @@ test_TrackCostsRestricting = let n = 30000 in test_TrackCostsWith "restricting" n $ \term -> case typecheckReadKnownCek def () term of - Left err -> fail $ displayPlcDef err - Right (Left err) -> fail $ displayPlcDef err + Left err -> fail $ displayPlc err + Right (Left err) -> fail $ displayPlc err Right (Right (res :: [Integer])) -> do let expected = n `div` 10 actual = length res @@ -439,8 +439,8 @@ test_TrackCostsRetaining = let (getRes, budgets) = runCekNoEmit params retaining term' in (getRes >>= readKnownSelf, budgets) case typecheckAndRunRetainer () term of - Left err -> fail $ displayPlcDef err - Right (Left err, _) -> fail $ displayPlcDef err + Left err -> fail $ displayPlc err + Right (Left err, _) -> fail $ displayPlc err Right (Right (res :: [Integer]), budgets) -> do -- @length budgets@ is for retaining @budgets@ for as long as possible just in case. -- @3@ is just for giving us room to handle erratic GC behavior. It really should be @@ -485,10 +485,10 @@ evals evals expectedVal fun typeArgs termArgs = let actualExpNoTermArgs = mkIterInstNoAnn (builtin () fun) typeArgs actualExp = mkIterAppNoAnn actualExpNoTermArgs termArgs - prename = stripParensIfAny . render $ prettyPlcReadableDef actualExp + prename = stripParensIfAny . render $ prettyPlcReadable actualExp -- Shorten the name of the test in case it's too long to be displayed in CLI. name = if length prename < 70 then prename else - stripParensIfAny (render $ prettyPlcReadableDef actualExpNoTermArgs) ++ + stripParensIfAny (render $ prettyPlcReadable actualExpNoTermArgs) ++ concatMap (\_ -> " <...>") termArgs expectedRes = Right . EvaluationSuccess $ cons expectedVal actualRes = typecheckEvaluateCekNoEmit def defaultBuiltinCostModelForTesting actualExp @@ -516,15 +516,15 @@ fails fileName fun typeArgs termArgs = do embed . testCase expectedToDisplay $ assertFailure "expected an evaluation failure, but got a success" Left err -> - let prename = stripParensIfAny . render $ prettyPlcReadableDef actualExp + let prename = stripParensIfAny . render $ prettyPlcReadable actualExp -- Shorten the name of the test in case it's too long to be displayed in CLI. name = if length prename < 70 then prename else - stripParensIfAny (render $ prettyPlcReadableDef actualExpNoTermArgs) ++ + stripParensIfAny (render $ prettyPlcReadable actualExpNoTermArgs) ++ concatMap (\_ -> " <...>") termArgs in testNestedNamedM mempty name $ testNestedNamedM mempty expectedToDisplay $ nestedGoldenVsDoc fileName ".err" . vsep $ concat - [ [prettyPlcReadableDef err] + [ [prettyPlcReadable err] , ["Logs were:" | not $ null logs] , map pretty logs ] diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Golden.hs index 7cbe242f97f..3da6ca9b6ad 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden.hs @@ -238,7 +238,7 @@ iteAtStringWithCond = Apply () iteAtString lteExpr -- @string@. It still runs succefully, because even in typed world (the CK machine) we don't look -- at types at runtime. iteAtStringWithCondWithIntegerWithString :: Term TyName Name DefaultUni DefaultFun () -iteAtStringWithCondWithIntegerWithString = mkIterAppNoAnn (iteAtStringWithCond) +iteAtStringWithCondWithIntegerWithString = mkIterAppNoAnn iteAtStringWithCond [ mkConstant @Integer () 33 , mkConstant @Text () "abc" ] @@ -395,7 +395,7 @@ caseNonTag = Case () integer (mkConstant @Integer () 1) [] goldenVsPretty :: PrettyPlc a => String -> String -> a -> TestTree goldenVsPretty extn name value = goldenVsString name ("untyped-plutus-core/test/Evaluation/Golden/" ++ name ++ extn) $ - pure . BSL.fromStrict . encodeUtf8 . render $ prettyPlcClassicDebug value + pure . BSL.fromStrict . encodeUtf8 . render $ prettyPlcClassicSimple value goldenVsEvaluatedCK :: String -> Term TyName Name DefaultUni DefaultFun () -> TestTree goldenVsEvaluatedCK name diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Machines.hs index 6174ac0326a..565b00a3f11 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines.hs @@ -75,8 +75,11 @@ testBudget runtime name term = nestedGoldenVsText name ".uplc" - (render $ - prettyPlcReadableDef $ runCekNoEmit (MachineParameters Plc.defaultCekMachineCostsForTesting runtime) Cek.tallying term) + (render + $ prettyPlcReadable + $ runCekNoEmit + (MachineParameters Plc.defaultCekMachineCostsForTesting runtime) + Cek.tallying term) bunchOfFibs :: PlcFolderContents DefaultUni DefaultFun bunchOfFibs = FolderContents [treeFolderContents "Fib" $ map fibFile [1..3]] where @@ -137,8 +140,7 @@ testTallying name term = nestedGoldenVsText name ".uplc" - (render $ - prettyPlcReadableDef $ runCekNoEmit Plc.defaultCekParametersForTesting Cek.tallying term) + (render $ prettyPlcReadable $ runCekNoEmit Plc.defaultCekParametersForTesting Cek.tallying term) test_tallying :: TestTree test_tallying = diff --git a/plutus-core/untyped-plutus-core/test/Generators.hs b/plutus-core/untyped-plutus-core/test/Generators.hs index 6bf54bc637b..7c56126d1a6 100644 --- a/plutus-core/untyped-plutus-core/test/Generators.hs +++ b/plutus-core/untyped-plutus-core/test/Generators.hs @@ -17,7 +17,7 @@ import PlutusCore.Generators.Hedgehog (forAllPretty) import PlutusCore.Generators.Hedgehog.AST (AstGen, runAstGen) import PlutusCore.Generators.Hedgehog.AST qualified as AST import PlutusCore.Parser (defaultUni, parseGen) -import PlutusCore.Pretty (displayPlcDef) +import PlutusCore.Pretty (displayPlc) import PlutusCore.Quote (QuoteT, runQuoteT) import UntypedPlutusCore qualified as UPLC import UntypedPlutusCore.Core.Type (Program (Program), Term (..), progTerm, termAnn) @@ -28,7 +28,7 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Vector qualified as V -import Hedgehog (annotate, failure, property, tripping, (===)) +import Hedgehog (annotate, annotateShow, failure, property, tripping, (===)) import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Test.Tasty (TestTree, testGroup) @@ -79,7 +79,7 @@ propFlat = testPropertyNamed "Flat" "Flat" $ property $ do propParser :: TestTree propParser = testPropertyNamed "Parser" "parser" $ property $ do prog <- TextualProgram <$> forAllPretty (runAstGen Generators.genProgram) - tripping prog (displayPlcDef . unTextualProgram) + tripping prog (displayPlc . unTextualProgram) (\p -> fmap (TextualProgram . void) (parseProg p)) where parseProg @@ -97,6 +97,7 @@ propTermSrcSpan = testPropertyNamed display <$> forAllPretty (view progTerm <$> runAstGen (Generators.genProgram @DefaultFun)) + annotateShow code let (endingLine, endingCol) = length &&& T.length . last $ T.lines code trailingSpaces <- forAllPretty $ Gen.text (Range.linear 0 10) (Gen.element [' ', '\n']) case runQuoteT . parseTerm @ParserErrorBundle $ code <> trailingSpaces of diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/Test.hs b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/Test.hs index 3e18bc27bb0..af1aab6571e 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/Test.hs +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/Test.hs @@ -134,5 +134,5 @@ goldenVsSimplified name = . BSL.fromStrict . encodeUtf8 . render - . prettyClassicDebug + . prettyClassicSimple . caseOfCase diff --git a/plutus-core/untyped-plutus-core/test/Transform/Simplify/Lib.hs b/plutus-core/untyped-plutus-core/test/Transform/Simplify/Lib.hs index 96a6e442e71..476ff9d7c54 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/Simplify/Lib.hs +++ b/plutus-core/untyped-plutus-core/test/Transform/Simplify/Lib.hs @@ -7,7 +7,7 @@ import Data.ByteString.Lazy qualified as BSL import Data.Text.Encoding (encodeUtf8) import PlutusCore qualified as PLC import PlutusCore.Builtin (BuiltinSemanticsVariant) -import PlutusCore.Pretty (PrettyPlc, Render (render), prettyPlcReadableDebug) +import PlutusCore.Pretty (PrettyPlc, Render (render), prettyPlcReadableSimple) import PlutusPrelude (Default (def)) import Test.Tasty (TestTree) import Test.Tasty.Golden (goldenVsString) @@ -19,7 +19,7 @@ goldenVsPretty :: (PrettyPlc a) => String -> String -> a -> TestTree goldenVsPretty extn name value = goldenVsString name ("untyped-plutus-core/test/Transform/" ++ name ++ extn) $ pure . BSL.fromStrict . encodeUtf8 . render $ - prettyPlcReadableDebug value + prettyPlcReadableSimple value goldenVsSimplified :: String -> Term Name PLC.DefaultUni PLC.DefaultFun () -> TestTree goldenVsSimplified name = diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs index ff2c7fe9d49..adab3155485 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs @@ -62,7 +62,7 @@ instance AsScriptDecodeError EvaluationError where _ScriptDecodeError = _CodecError instance Pretty EvaluationError where - pretty (CekError e) = prettyClassicDef e + pretty (CekError e) = prettyClassic e pretty (DeBruijnError e) = pretty e pretty (CodecError e) = pretty e pretty CostModelParameterMismatch = "Cost model parameters were not as we expected" diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Error.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Error.hs index f3768e31111..0de72379a1a 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Error.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Error.hs @@ -74,7 +74,7 @@ data Error uni fun a makeClassyPrisms ''Error instance (PLC.PrettyUni uni, PP.Pretty fun, PP.Pretty a) => PP.Pretty (Error uni fun a) where - pretty = PLC.prettyPlcClassicDebug + pretty = PLC.prettyPlcClassicSimple instance (uni1 ~ uni2, b ~ PIR.Provenance a) => diff --git a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs index 61d50b7c0a0..ae037a1a605 100644 --- a/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs +++ b/plutus-tx-plugin/src/PlutusTx/Compiler/Expr.hs @@ -521,7 +521,7 @@ maybeProfileRhs var t = do CompileContext{ccOpts = compileOpts} <- ask let ty = PLC._varDeclType var varName = PLC._varDeclName var - displayName = T.pack $ PP.displayPlcDef varName + displayName = T.pack $ PP.displayPlc varName isFunctionOrAbstraction = case ty of PLC.TyFun{} -> True; PLC.TyForall{} -> True; _ -> False -- Trace only if profiling is on *and* the thing being defined is a function if coProfile compileOpts == All && isFunctionOrAbstraction diff --git a/plutus-tx-plugin/test/Lib.hs b/plutus-tx-plugin/test/Lib.hs index 66210e22cda..1d75a184cd4 100644 --- a/plutus-tx-plugin/test/Lib.hs +++ b/plutus-tx-plugin/test/Lib.hs @@ -6,8 +6,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} -{-# OPTIONS_GHC -Wno-orphans #-} module Lib where import Control.Exception @@ -33,31 +33,50 @@ import UntypedPlutusCore qualified as UPLC import UntypedPlutusCore.Evaluation.Machine.Cek goldenPir - :: (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) - => String -> CompiledCodeIn uni fun a -> TestNested -goldenPir name value = nestedGoldenVsDoc name ".pir" $ pretty $ getPirNoAnn value + :: (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) + => String + -> CompiledCodeIn uni fun a + -> TestNested +goldenPir name value = + nestedGoldenVsDoc name ".pir" $ + prettyPlcClassicSimple $ + getPirNoAnn value -runPlcCek :: ToUPlc a PLC.DefaultUni PLC.DefaultFun => [a] -> ExceptT SomeException IO (UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun ()) +runPlcCek + :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) + => [a] + -> ExceptT SomeException IO (UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun ()) runPlcCek values = do - ps <- traverse toUPlc values - let p = - foldl1 (unsafeFromRight .* UPLC.applyProgram) ps - fromRightM (throwError . SomeException) $ evaluateCekNoEmit PLC.defaultCekParametersForTesting (p ^. UPLC.progTerm) - -runPlcCekTrace :: - ToUPlc a PLC.DefaultUni PLC.DefaultFun => - [a] -> - ExceptT SomeException IO ([Text], CekExTally PLC.DefaultFun, UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun ()) + ps <- traverse toUPlc values + let p = foldl1 (unsafeFromRight .* UPLC.applyProgram) ps + fromRightM (throwError . SomeException) $ + evaluateCekNoEmit PLC.defaultCekParametersForTesting (p ^. UPLC.progTerm) + +runPlcCekTrace + :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) + => [a] + -> ExceptT + SomeException + IO + ( [Text] + , CekExTally PLC.DefaultFun + , UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun () + ) runPlcCekTrace values = do - ps <- traverse toUPlc values - let p = - foldl1 (unsafeFromRight .* UPLC.applyProgram) ps - let (result, TallyingSt tally _, logOut) = runCek PLC.defaultCekParametersForTesting tallying logEmitter (p ^. UPLC.progTerm) - res <- fromRightM (throwError . SomeException) result - pure (logOut, tally, res) - -goldenEvalCek :: ToUPlc a PLC.DefaultUni PLC.DefaultFun => String -> [a] -> TestNested -goldenEvalCek name values = nestedGoldenVsDocM name ".eval-cek" $ prettyPlcClassicDebug <$> (rethrow $ runPlcCek values) - -goldenEvalCekLog :: ToUPlc a PLC.DefaultUni PLC.DefaultFun => String -> [a] -> TestNested -goldenEvalCekLog name values = nestedGoldenVsDocM name ".eval-cek-log" $ pretty . view _1 <$> (rethrow $ runPlcCekTrace values) + ps <- traverse toUPlc values + let p = + foldl1 (unsafeFromRight .* UPLC.applyProgram) ps + let (result, TallyingSt tally _, logOut) = + runCek PLC.defaultCekParametersForTesting tallying logEmitter (p ^. UPLC.progTerm) + res <- fromRightM (throwError . SomeException) result + pure (logOut, tally, res) + +goldenEvalCek :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => String -> [a] -> TestNested +goldenEvalCek name values = + nestedGoldenVsDocM name ".eval-cek" $ + prettyPlcClassicSimple <$> (rethrow $ runPlcCek values) + +goldenEvalCekLog :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => String -> [a] -> TestNested +goldenEvalCekLog name values = + nestedGoldenVsDocM name ".eval-cek-log" $ + prettyPlcClassicSimple . view _1 <$> (rethrow $ runPlcCekTrace values) diff --git a/plutus-tx-plugin/test/Plugin/Debug/Spec.hs b/plutus-tx-plugin/test/Plugin/Debug/Spec.hs index 987405909cb..250d29daa59 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Debug/Spec.hs @@ -29,7 +29,7 @@ debug = , goldenPirBy config "fib" fib ] where - config = PrettyConfigClassic defPrettyConfigName True + config = PrettyConfigClassic prettyConfigName True letFun :: CompiledCode (Integer -> Integer -> Bool) letFun = diff --git a/plutus-tx-plugin/test/Plugin/Profiling/Spec.hs b/plutus-tx-plugin/test/Plugin/Profiling/Spec.hs index 999acbebbe2..b611b8b7603 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/Spec.hs +++ b/plutus-tx-plugin/test/Plugin/Profiling/Spec.hs @@ -1,19 +1,25 @@ --- editorconfig-checker-disable-file +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} -{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:context-level=3 #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-cse-iterations=0 #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-simplifier-iterations-pir=0 #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-simplifier-iterations-uplc=0 #-} -{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:max-cse-iterations=0 #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:profile-all #-} --- | Tests for the profiling machinery. +{-# HLINT ignore "Eta reduce" #-} +{-# HLINT ignore "Use guards" #-} +{-# HLINT ignore "Redundant id" #-} +{-# HLINT ignore "Use id" #-} +{-# HLINT ignore "Use const" #-} +-- | Tests for the profiling machinery. module Plugin.Profiling.Spec where import Test.Tasty.Extras @@ -29,22 +35,56 @@ import Data.Proxy (Proxy (Proxy)) import Prelude profiling :: TestNested -profiling = testNested "Profiling" . pure $ testNestedGhc - [ goldenPir "fib" fibTest - , goldenUEvalLogs "fib4" [toUPlc fibTest, toUPlc $ plc (Proxy @"4") (4::Integer)] - , goldenUEvalLogs "fact4" [toUPlc factTest, toUPlc $ plc (Proxy @"4") (4::Integer)] - , goldenPir "addInt" addIntTest - , goldenUEvalLogs "addInt3" [toUPlc addIntTest, toUPlc $ plc (Proxy @"3") (3::Integer)] - , goldenUEvalLogs "letInFun" [toUPlc letInFunTest, toUPlc $ plc (Proxy @"1") (1::Integer), toUPlc $ plc (Proxy @"4") (4::Integer)] - , goldenUEvalLogs "letInFunMoreArg" [toUPlc letInFunMoreArgTest, toUPlc $ plc (Proxy @"1") (1::Integer), toUPlc $ plc (Proxy @"4") (4::Integer), toUPlc $ plc (Proxy @"5") (5::Integer)] - , goldenUEvalLogs "letRecInFun" [toUPlc letRecInFunTest, toUPlc $ plc (Proxy @"3") (3::Integer)] - , goldenPir "idCode" idTest - , goldenUEvalLogs "id" [toUPlc idTest] - , goldenUEvalLogs "swap" [toUPlc swapTest] - , goldenUEvalLogs "typeclass" [toUPlc typeclassTest, toUPlc $ plc (Proxy @"1") (1::Integer), toUPlc $ plc (Proxy @"4") (4::Integer)] - , goldenUEvalLogs "argMismatch1" [toUPlc argMismatch1] - , goldenUEvalLogs "argMismatch2" [toUPlc argMismatch2] - ] +profiling = + testNested "Profiling" . pure $ do + testNestedGhc + [ goldenPir "fib" fibTest + , goldenUEvalLogs + "fib4" + [ toUPlc fibTest + , toUPlc $ plc (Proxy @"4") (4 :: Integer) + ] + , goldenUEvalLogs + "fact4" + [ toUPlc factTest + , toUPlc $ plc (Proxy @"4") (4 :: Integer) + ] + , goldenPir "addInt" addIntTest + , goldenUEvalLogs + "addInt3" + [ toUPlc addIntTest + , toUPlc $ plc (Proxy @"3") (3 :: Integer) + ] + , goldenUEvalLogs + "letInFun" + [ toUPlc letInFunTest + , toUPlc $ plc (Proxy @"1") (1 :: Integer) + , toUPlc $ plc (Proxy @"4") (4 :: Integer) + ] + , goldenUEvalLogs + "letInFunMoreArg" + [ toUPlc letInFunMoreArgTest + , toUPlc $ plc (Proxy @"1") (1 :: Integer) + , toUPlc $ plc (Proxy @"4") (4 :: Integer) + , toUPlc $ plc (Proxy @"5") (5 :: Integer) + ] + , goldenUEvalLogs + "letRecInFun" + [ toUPlc letRecInFunTest + , toUPlc $ plc (Proxy @"3") (3 :: Integer) + ] + , goldenPir "idCode" idTest + , goldenUEvalLogs "id" [toUPlc idTest] + , goldenUEvalLogs "swap" [toUPlc swapTest] + , goldenUEvalLogs + "typeclass" + [ toUPlc typeclassTest + , toUPlc $ plc (Proxy @"1") (1 :: Integer) + , toUPlc $ plc (Proxy @"4") (4 :: Integer) + ] + , goldenUEvalLogs "argMismatch1" [toUPlc argMismatch1] + , goldenUEvalLogs "argMismatch2" [toUPlc argMismatch2] + ] fact :: Integer -> Integer fact n = @@ -56,11 +96,16 @@ factTest :: CompiledCode (Integer -> Integer) factTest = plc (Proxy @"fact") fact fib :: Integer -> Integer -fib n = if Builtins.equalsInteger n 0 - then 0 - else if Builtins.equalsInteger n 1 - then 1 - else Builtins.addInteger (fib(Builtins.subtractInteger n 1)) (fib(Builtins.subtractInteger n 2)) +fib n = + if Builtins.equalsInteger n 0 + then 0 + else + if Builtins.equalsInteger n 1 + then 1 + else + Builtins.addInteger + (fib (Builtins.subtractInteger n 1)) + (fib (Builtins.subtractInteger n 2)) fibTest :: CompiledCode (Integer -> Integer) -- not using case to avoid literal cases @@ -74,66 +119,70 @@ addIntTest = plc (Proxy @"addInt") addInt -- \x y -> let f z = z + 1 in f x + f y letInFunTest :: CompiledCode (Integer -> Integer -> Integer) -letInFunTest = - plc - (Proxy @"letInFun") - (\(x::Integer) (y::Integer) - -> let f z = Builtins.addInteger z 1 in Builtins.addInteger (f x) (f y)) +letInFunTest = plc (Proxy @"letInFun") do + \(x :: Integer) (y :: Integer) -> + let f z = Builtins.addInteger z 1 in Builtins.addInteger (f x) (f y) -- \x y z -> let f n = n + 1 in z * (f x + f y) letInFunMoreArgTest :: CompiledCode (Integer -> Integer -> Integer -> Integer) -letInFunMoreArgTest = - plc - (Proxy @"letInFun") - (\(x::Integer) (y::Integer) (z::Integer) - -> let f n = Builtins.addInteger n 1 in - Builtins.multiplyInteger z (Builtins.addInteger (f x) (f y))) +letInFunMoreArgTest = plc (Proxy @"letInFun") do + \(x :: Integer) (y :: Integer) (z :: Integer) -> + let f n = Builtins.addInteger n 1 + in Builtins.multiplyInteger z (Builtins.addInteger (f x) (f y)) -- Try a recursive function so it definitely won't be inlined letRecInFunTest :: CompiledCode (Integer -> Integer) -letRecInFunTest = - plc - (Proxy @"letRecInFun") - (\(x::Integer) -> let f n = if Builtins.equalsInteger n 0 then 0 else Builtins.addInteger 1 (f (Builtins.subtractInteger n 1)) in f x) +letRecInFunTest = plc (Proxy @"letRecInFun") do + \(x :: Integer) -> + let f n = + if Builtins.equalsInteger n 0 + then 0 + else Builtins.addInteger 1 (f (Builtins.subtractInteger n 1)) + in f x idTest :: CompiledCode Integer -idTest = plc (Proxy @"id") (id (id (1::Integer))) +idTest = plc (Proxy @"id") do + id (id (1 :: Integer)) -swap :: (a,b) -> (b,a) -swap (a,b) = (b,a) +swap :: (a, b) -> (b, a) +swap (a, b) = (b, a) swapTest :: CompiledCode (Integer, Bool) -swapTest = plc (Proxy @"swap") (swap (True,1)) +swapTest = plc (Proxy @"swap") (swap (True, 1)) --- Two method typeclasses definitely get dictionaries, rather than just being passed as single functions +-- Two method typeclasses definitely get dictionaries, +-- rather than just being passed as single functions class TwoMethods a where - methodA :: a -> a -> Integer - methodB :: a -> a -> Integer + methodA :: a -> a -> Integer + methodB :: a -> a -> Integer instance TwoMethods Integer where - {-# INLINABLE methodA #-} - methodA = Builtins.addInteger - {-# INLINABLE methodB #-} - methodB = Builtins.subtractInteger + {-# INLINEABLE methodA #-} + methodA = Builtins.addInteger + {-# INLINEABLE methodB #-} + methodB = Builtins.subtractInteger -- Make a function that uses the typeclass polymorphically to check that -useTypeclass :: TwoMethods a => a -> a -> Integer +useTypeclass :: (TwoMethods a) => a -> a -> Integer useTypeclass a b = Builtins.addInteger (methodA a b) (methodB a b) -- Check that typeclass methods get traces typeclassTest :: CompiledCode (Integer -> Integer -> Integer) -typeclassTest = plc (Proxy @"typeclass") (\(x::Integer) (y::Integer) -> useTypeclass x y) +typeclassTest = plc (Proxy @"typeclass") do + \(x :: Integer) (y :: Integer) -> useTypeclass x y -{-# INLINABLE newtypeFunction #-} +{-# INLINEABLE newtypeFunction #-} newtypeFunction :: a -> Identity (a -> a) newtypeFunction _ = Identity (\a -> a) argMismatch1 :: CompiledCode Integer -argMismatch1 = plc (Proxy @"argMismatch1") (runIdentity (newtypeFunction 1) 1) +argMismatch1 = plc (Proxy @"argMismatch1") do + runIdentity (newtypeFunction 1) 1 -{-# INLINABLE obscuredFunction #-} +{-# INLINEABLE obscuredFunction #-} obscuredFunction :: (a -> a -> a) -> a -> a -> a obscuredFunction f a = f a argMismatch2 :: CompiledCode Integer -argMismatch2 = plc (Proxy @"argMismatch2") (obscuredFunction (\a _ -> a) 1 2) +argMismatch2 = plc (Proxy @"argMismatch2") do + obscuredFunction (\a _ -> a) 1 2 diff --git a/plutus-tx-plugin/test/StdLib/Spec.hs b/plutus-tx-plugin/test/StdLib/Spec.hs index 8d45fee88f4..0057ab7d3c1 100644 --- a/plutus-tx-plugin/test/StdLib/Spec.hs +++ b/plutus-tx-plugin/test/StdLib/Spec.hs @@ -1,5 +1,6 @@ --- editorconfig-checker-disable-file +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} @@ -13,32 +14,31 @@ module StdLib.Spec where import Control.DeepSeq (NFData, force) import Control.Exception (SomeException, evaluate, try) +import Control.Monad.Except (runExceptT) import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Proxy (Proxy (..)) import Data.Ratio ((%)) import GHC.Exts (fromString) import Hedgehog (MonadGen, Property) import Hedgehog qualified import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range -import PlutusCore.Test (TestNested, embed, goldenUEval, testNested, testNestedGhc) -import PlutusTx.Test (goldenPir) -import Test.Tasty (TestName) -import Test.Tasty.Hedgehog (testPropertyNamed) - -import PlutusTx.Eq qualified as PlutusTx -import PlutusTx.Ord qualified as PlutusTx -import PlutusTx.Prelude qualified as PlutusTx -import PlutusTx.Ratio qualified as Ratio - +import PlutusCore.Data qualified as PLC +import PlutusCore.MkPlc qualified as Core +import PlutusCore.Test (TestNested, embed, runUPlc, testNested, testNestedGhc) +import PlutusPrelude (reoption) import PlutusTx.Builtins.Internal (BuiltinData (BuiltinData)) import PlutusTx.Code (CompiledCode, getPlcNoAnn) +import PlutusTx.Eq qualified as PlutusTx import PlutusTx.Lift qualified as Lift +import PlutusTx.Ord qualified as PlutusTx import PlutusTx.Plugin (plc) - -import PlutusCore.Data qualified as PLC - -import Data.Proxy (Proxy (Proxy)) -import PlutusPrelude (reoption) +import PlutusTx.Prelude qualified as PlutusTx +import PlutusTx.Ratio qualified as Ratio +import PlutusTx.Test (goldenPir) +import Test.Tasty (TestName, TestTree) +import Test.Tasty.Hedgehog (testPropertyNamed) +import Test.Tasty.HUnit (assertFailure, testCase, (@?=)) roundPlc :: CompiledCode (Ratio.Rational -> Integer) roundPlc = plc (Proxy @"roundPlc") Ratio.round @@ -46,7 +46,7 @@ roundPlc = plc (Proxy @"roundPlc") Ratio.round tests :: TestNested tests = testNested "StdLib" . pure $ testNestedGhc - [ goldenUEval "ratioInterop" [ getPlcNoAnn roundPlc, snd (Lift.liftProgramDef (Ratio.fromGHC 3.75)) ] + [ embed testRatioInterop , testRatioProperty "round" Ratio.round round , testRatioProperty "truncate" Ratio.truncate truncate , testRatioProperty "abs" (fmap Ratio.toGHC Ratio.abs) abs @@ -66,8 +66,17 @@ tryHard :: (MonadIO m, NFData a) => a -> m (Maybe a) -- the body, i.e. outside of the call to 'try', defeating the whole purpose. tryHard ~a = reoption <$> (liftIO $ try @SomeException $ evaluate $ force a) -testRatioProperty :: (Show a, Eq a) => TestName -> (Ratio.Rational -> a) -> (Rational -> a) -> TestNested -testRatioProperty nm plutusFunc ghcFunc = embed $ testPropertyNamed nm (fromString nm) $ Hedgehog.property $ do +testRatioInterop :: TestTree +testRatioInterop = testCase "ratioInterop" do + runExceptT (runUPlc [getPlcNoAnn roundPlc, snd (Lift.liftProgramDef (Ratio.fromGHC 3.75))]) + >>= \case + Left e -> assertFailure (show e) + Right r -> r @?= Core.mkConstant () (4 :: Integer) + +testRatioProperty :: + (Show a, Eq a) => TestName -> (Ratio.Rational -> a) -> (Rational -> a) -> TestNested +testRatioProperty nm plutusFunc ghcFunc = + embed $ testPropertyNamed nm (fromString nm) $ Hedgehog.property $ do rat <- Hedgehog.forAll $ Gen.realFrac_ (Range.linearFrac (-10000) 100000) let ghcResult = ghcFunc rat plutusResult = plutusFunc $ Ratio.fromGHC rat diff --git a/plutus-tx/testlib/PlutusTx/Test.hs b/plutus-tx/testlib/PlutusTx/Test.hs index c6fe9b747e0..edc247bf3b2 100644 --- a/plutus-tx/testlib/PlutusTx/Test.hs +++ b/plutus-tx/testlib/PlutusTx/Test.hs @@ -52,6 +52,7 @@ import PlutusCore.Pretty import PlutusCore.Pretty qualified as PLC import PlutusCore.Test import PlutusIR.Analysis.Builtins as PIR +import PlutusIR.Core.Instance.Pretty.Readable (prettyPirReadableSimple) import PlutusIR.Core.Type (progTerm) import PlutusIR.Test () import PlutusIR.Transform.RewriteRules as PIR @@ -122,7 +123,7 @@ goldenPir :: String -> CompiledCodeIn uni fun a -> TestNested -goldenPir name value = nestedGoldenVsDoc name ".pir" $ pretty $ getPirNoAnn value +goldenPir name value = nestedGoldenVsDoc name ".pir" $ prettyPirReadableSimple $ getPirNoAnn value -- | Does not print uniques. goldenPirReadable :: @@ -132,7 +133,7 @@ goldenPirReadable :: TestNested goldenPirReadable name value = nestedGoldenVsDoc name ".pir" - . maybe "PIR not found in CompiledCode" (pretty . AsReadable . view progTerm) + . maybe "PIR not found in CompiledCode" (prettyPirReadableSimple . view progTerm) $ getPirNoAnn value goldenPirBy :: @@ -143,25 +144,24 @@ goldenPirBy :: TestNested goldenPirBy config name value = nestedGoldenVsDoc name ".pir" $ - pretty $ - AttachPrettyConfig config $ - getPir value + prettyBy config $ getPir value -- Evaluation testing -- TODO: rationalize with the functions exported from PlcTestUtils goldenEvalCek :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => String -> [a] -> TestNested goldenEvalCek name values = - nestedGoldenVsDocM name ".eval" $ prettyPlcClassicDebug <$> (rethrow $ runPlcCek values) + nestedGoldenVsDocM name ".eval" $ prettyPlcClassicSimple <$> rethrow (runPlcCek values) goldenEvalCekCatch :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => String -> [a] -> TestNested goldenEvalCekCatch name values = nestedGoldenVsDocM name ".eval" $ - either (pretty . show) prettyPlcClassicDebug <$> runExceptT (runPlcCek values) + either (pretty . show) prettyPlcClassicSimple <$> runExceptT (runPlcCek values) goldenEvalCekLog :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => String -> [a] -> TestNested goldenEvalCekLog name values = - nestedGoldenVsDocM name ".eval" $ pretty . view _1 <$> (rethrow $ runPlcCekTrace values) + nestedGoldenVsDocM name ".eval" $ + prettyPlcClassicSimple . view _1 <$> (rethrow $ runPlcCekTrace values) -- Helpers From ffc3cf0f13ee17da1d9899533dd1171768fabaa8 Mon Sep 17 00:00:00 2001 From: Yura Lazaryev Date: Wed, 29 May 2024 10:29:54 +0200 Subject: [PATCH 4/4] Updated golden files --- .../Validator/GoldenTests/sorted.pir.golden | 10911 ++++++++-------- .../Validator/GoldenTests/sorted.uplc.golden | 2153 +-- .../Validator/GoldenTests/unsorted.pir.golden | 10788 +++++++-------- .../GoldenTests/unsorted.uplc.golden | 2771 ++-- .../plutus-core/test/scopes/apply.plc.golden | 2 +- .../plutus-core/test/scopes/lambda.plc.golden | 2 +- .../test/scopes/lambda2.plc.golden | 2 +- .../test/scopes/negation.plc.golden | 20 +- .../Compiler/Datatype/dataEscape.golden | 2 +- .../PlutusIR/Compiler/Datatype/idleAll.golden | 2 +- .../Compiler/Datatype/listMatch.golden | 250 +- .../Compiler/Datatype/listMatchEval.golden | 2 +- .../PlutusIR/Compiler/Datatype/maybe.golden | 92 +- .../Compiler/Datatype/scott/listMatch.golden | 365 +- .../Compiler/Datatype/scott/maybe.golden | 135 +- .../PlutusIR/Compiler/Datatype/some.golden | 2 +- .../Compiler/Error/recursiveTypeBind.golden | 4 +- .../test/PlutusIR/Compiler/Let/letDep.golden | 2 +- .../PlutusIR/Compiler/Let/letInLet.golden | 2 +- .../PlutusIR/Compiler/Recursion/even3.golden | 757 +- .../Compiler/Recursion/even3Eval.golden | 2 +- .../Compiler/Recursion/factorial.golden | 45 +- .../Recursion/mutuallyRecursiveValues.golden | 517 +- .../Compiler/Recursion/stupidZero.golden | 245 +- .../PlutusIR/Core/prettyprinting/basic.golden | 2 +- .../PlutusIR/Core/prettyprinting/maybe.golden | 18 +- .../Core/prettyprintingReadable/basic.golden | 2 +- .../errorBinding.golden | 4 +- .../Core/prettyprintingReadable/even3.golden | 26 +- .../prettyprintingReadable/idleAll.golden | 10 +- .../Core/prettyprintingReadable/letDep.golden | 6 +- .../prettyprintingReadable/letInLet.golden | 8 +- .../prettyprintingReadable/listMatch.golden | 19 +- .../Core/prettyprintingReadable/maybe.golden | 8 +- .../mutuallyRecursiveValues.golden | 6 +- .../recursiveTypeBind.golden | 6 +- .../Core/prettyprintingReadable/some.golden | 6 +- .../prettyprintingReadable/stupidZero.golden | 19 +- .../Core/serialization/serializeBasic.golden | 2 +- .../serialization/serializeEvenOdd.golden | 63 +- .../serialization/serializeListMatch.golden | 40 +- .../serializeMaybePirTerm.golden | 18 +- .../Purity/builtinAppSaturated.golden | 2 +- .../Purity/builtinAppUnsaturated.golden | 2 +- .../test/PlutusIR/Purity/letFun.golden | 6 +- .../test/PlutusIR/Purity/nestedLets1.golden | 10 +- .../test/PlutusIR/Purity/pureLet.golden | 6 +- .../PlutusIR/Transform/Beta/absapp.golden | 5 +- .../PlutusIR/Transform/Beta/lamapp.golden | 5 +- .../PlutusIR/Transform/Beta/lamapp2.golden | 15 +- .../PlutusIR/Transform/Beta/multiapp.golden | 17 +- .../PlutusIR/Transform/Beta/multilet.golden | 27 +- .../Transform/CaseOfCase/basic.golden | 53 +- .../Transform/CaseOfCase/builtinBool.golden | 48 +- .../Transform/CaseOfCase/exponential.golden | 152 +- .../Transform/CaseOfCase/largeExpr.golden | 62 +- .../Transform/CaseOfCase/twoTyArgs.golden | 55 +- .../Transform/DeadCode/builtinBinding.golden | 2 +- .../Transform/DeadCode/datatypeDead.golden | 2 +- .../DeadCode/datatypeLiveConstr.golden | 18 +- .../DeadCode/datatypeLiveDestr.golden | 18 +- .../DeadCode/datatypeLiveType.golden | 12 +- .../DeadCode/etaBuiltinBinding.golden | 2 +- .../Transform/DeadCode/nestedBindings.golden | 13 +- .../DeadCode/nestedBindingsIndirect.golden | 24 +- .../Transform/DeadCode/nonstrictLet.golden | 13 +- .../Transform/DeadCode/pruneDatatype.golden | 16 +- .../DeadCode/recBindingComplex.golden | 13 +- .../DeadCode/recBindingSimple.golden | 2 +- .../Transform/DeadCode/singleBinding.golden | 13 +- .../Transform/DeadCode/strictLet.golden | 24 +- .../Transform/DeadCode/termLet.golden | 2 +- .../Transform/DeadCode/typeLet.golden | 2 +- .../EvaluateBuiltins/addInteger.golden | 2 +- .../EvaluateBuiltins/failingBuiltin.golden | 2 +- .../EvaluateBuiltins/ifThenElse.golden | 2 +- .../EvaluateBuiltins/nonConstantArg.golden | 9 +- .../EvaluateBuiltins/overApplication.golden | 2 +- .../EvaluateBuiltins/traceConservative.golden | 2 +- .../traceNonConservative.golden | 2 +- ...ncompressAndEqualBlsNonConservative.golden | 24 +- .../uncompressBlsConservative.golden | 9 +- .../uncompressBlsNonConservative.golden | 9 +- .../EvaluateBuiltins/underApplication.golden | 2 +- .../PlutusIR/Transform/Inline/builtin.golden | 2 +- .../Inline/callsite-non-trivial-body.golden | 85 +- .../PlutusIR/Transform/Inline/constant.golden | 2 +- .../Inline/effectfulBuiltinArg.golden | 33 +- .../Inline/firstEffectfulTerm1.golden | 2 +- .../Inline/firstEffectfulTerm2.golden | 13 +- .../Transform/Inline/immediateApp.golden | 2 +- .../Transform/Inline/immediateVar.golden | 2 +- .../Inline/inlineConstantsOff.golden | 9 +- .../Transform/Inline/inlineConstantsOn.golden | 5 +- .../PlutusIR/Transform/Inline/letApp.golden | 2 +- .../Inline/letAppMultiNotAcceptable.golden | 13 +- .../Transform/Inline/letFunConstBool.golden | 18 +- .../Transform/Inline/letFunConstInt.golden | 5 +- .../Transform/Inline/letFunConstMulti.golden | 13 +- .../Transform/Inline/letFunInFun.golden | 2 +- .../Transform/Inline/letFunInFunMulti.golden | 13 +- .../Transform/Inline/letNonPure.golden | 15 +- .../Transform/Inline/letNonPureMulti.golden | 22 +- .../Inline/letNonPureMultiStrict.golden | 15 +- .../Transform/Inline/letOverApp.golden | 5 +- .../Transform/Inline/letOverAppMulti.golden | 30 +- .../Transform/Inline/letOverAppType.golden | 11 +- .../Transform/Inline/letTypeApp.golden | 2 +- .../Transform/Inline/letTypeApp2.golden | 14 +- .../Transform/Inline/letTypeAppMulti.golden | 11 +- .../Inline/letTypeAppMultiNotSat.golden | 11 +- .../Inline/letTypeAppMultiSat.golden | 13 +- .../PlutusIR/Transform/Inline/multilet.golden | 35 +- .../Transform/Inline/nameCapture.golden | 19 +- .../Transform/Inline/partiallyApp.golden | 30 +- .../Transform/Inline/rhs-modified.golden | 17 +- .../PlutusIR/Transform/Inline/single.golden | 24 +- .../Transform/Inline/transitive.golden | 2 +- .../PlutusIR/Transform/Inline/tyvar.golden | 2 +- .../test/PlutusIR/Transform/Inline/var.golden | 2 +- .../Transform/KnownCon/applicative.golden | 152 +- .../PlutusIR/Transform/KnownCon/bool.golden | 18 +- .../PlutusIR/Transform/KnownCon/list.golden | 39 +- .../KnownCon/maybe-just-unsaturated.golden | 34 +- .../Transform/KnownCon/maybe-just.golden | 28 +- .../Transform/KnownCon/maybe-nothing.golden | 18 +- .../PlutusIR/Transform/KnownCon/pair.golden | 32 +- .../avoid-floating-into-lam.golden | 25 +- .../avoid-floating-into-tyabs.golden | 21 +- .../relaxed/avoid-floating-into-RHS.golden | 17 +- ...oid-moving-strict-nonvalue-bindings.golden | 17 +- .../relaxed/cannot-float-into-app.golden | 19 +- .../LetFloatIn/relaxed/datatype1.golden | 26 +- .../LetFloatIn/relaxed/datatype2.golden | 33 +- .../LetFloatIn/relaxed/float-into-RHS.golden | 29 +- .../relaxed/float-into-case-arg.golden | 21 +- .../relaxed/float-into-case-branch.golden | 21 +- .../relaxed/float-into-constr.golden | 17 +- .../relaxed/float-into-fun-and-arg-1.golden | 33 +- .../relaxed/float-into-fun-and-arg-2.golden | 36 +- .../LetFloatIn/relaxed/float-into-lam1.golden | 18 +- .../LetFloatIn/relaxed/float-into-lam2.golden | 29 +- .../relaxed/float-into-tyabs1.golden | 52 +- .../relaxed/float-into-tyabs2.golden | 25 +- .../Transform/LetFloatIn/relaxed/type.golden | 35 +- .../Transform/LetFloatOut/even3Eval.golden | 62 +- .../Transform/LetFloatOut/ifError.golden | 38 +- .../Transform/LetFloatOut/inLam.golden | 14 +- .../Transform/LetFloatOut/letInLet.golden | 15 +- .../Transform/LetFloatOut/listMatch.golden | 54 +- .../Transform/LetFloatOut/maybe.golden | 34 +- .../LetFloatOut/mutuallyRecursiveTypes.golden | 29 +- .../mutuallyRecursiveValues.golden | 15 +- .../Transform/LetFloatOut/nonrec1.golden | 17 +- .../Transform/LetFloatOut/nonrec2.golden | 38 +- .../Transform/LetFloatOut/nonrec3.golden | 14 +- .../Transform/LetFloatOut/nonrec4.golden | 24 +- .../Transform/LetFloatOut/nonrec6.golden | 22 +- .../Transform/LetFloatOut/nonrec7.golden | 28 +- .../Transform/LetFloatOut/nonrec8.golden | 35 +- .../Transform/LetFloatOut/nonrec9.golden | 15 +- .../LetFloatOut/nonrecToNonrec.golden | 13 +- .../Transform/LetFloatOut/nonrecToRec.golden | 15 +- .../Transform/LetFloatOut/oldFloatBug.golden | 15 +- .../Transform/LetFloatOut/oldLength.golden | 25 +- .../Transform/LetFloatOut/outLam.golden | 9 +- .../Transform/LetFloatOut/outRhs.golden | 19 +- .../Transform/LetFloatOut/rec1.golden | 40 +- .../Transform/LetFloatOut/rec2.golden | 56 +- .../Transform/LetFloatOut/rec3.golden | 24 +- .../Transform/LetFloatOut/rec4.golden | 13 +- .../LetFloatOut/rhsSqueezeVsNest.golden | 37 +- .../LetFloatOut/strictNonValue.golden | 17 +- .../LetFloatOut/strictNonValue2.golden | 11 +- .../LetFloatOut/strictNonValue3.golden | 26 +- .../LetFloatOut/strictNonValueDeep.golden | 26 +- .../Transform/LetFloatOut/strictValue.golden | 19 +- .../LetFloatOut/strictValueNonValue.golden | 24 +- .../LetFloatOut/strictValueValue.golden | 19 +- .../Transform/NonStrict/nonStrict1.golden | 13 +- .../PlutusIR/Transform/RecSplit/big.golden | 68 +- .../RecSplit/mutuallyRecursiveTypes.golden | 38 +- .../RecSplit/mutuallyRecursiveValues.golden | 15 +- .../Transform/RecSplit/selfrecursive.golden | 36 +- .../PlutusIR/Transform/RecSplit/small.golden | 28 +- .../Transform/RecSplit/truenonrec.golden | 35 +- .../Rename/allShadowedDataNonRec.golden | 17 +- .../Rename/allShadowedDataRec.golden | 17 +- .../Rename/paramShadowedDataNonRec.golden | 17 +- .../Rename/paramShadowedDataRec.golden | 17 +- .../RewriteRules/divideInt.pir.golden | 8 +- .../RewriteRules/equalsInt.pir.golden | 5 +- .../Transform/RewriteRules/let.pir.golden | 12 +- .../RewriteRules/multiplyInt.pir.golden | 5 +- .../unConstrConstrDataFst.pir.golden | 54 +- .../unConstrConstrDataSnd.pir.golden | 22 +- .../Transform/StrictifyBindings/conapp.golden | 30 +- .../StrictifyBindings/impure1.golden | 15 +- .../Transform/StrictifyBindings/pure1.golden | 5 +- .../Transform/StrictifyBindings/unused.golden | 9 +- .../ThunkRecursions/errorBinding.golden | 14 +- .../Transform/ThunkRecursions/listFold.golden | 94 +- .../ThunkRecursions/listFoldTrace.golden | 98 +- .../Transform/ThunkRecursions/monoMap.golden | 64 +- .../mutuallyRecursiveValues.golden | 24 +- .../preserveEffectOrder.golden | 31 +- .../ThunkRecursions/preserveStrictness.golden | 20 +- .../Transform/Unwrap/unwrapWrap.golden | 41 +- .../test/PlutusIR/TypeCheck/even3Eval.golden | 2 +- .../test/PlutusIR/TypeCheck/ifError.golden | 2 +- .../test/PlutusIR/TypeCheck/letInLet.golden | 2 +- .../test/PlutusIR/TypeCheck/listMatch.golden | 2 +- .../test/PlutusIR/TypeCheck/maybe.golden | 2 +- .../TypeCheck/mutuallyRecursiveTypes.golden | 2 +- .../TypeCheck/mutuallyRecursiveValues.golden | 2 +- .../TypeCheck/nonSelfRecursive.golden | 2 +- .../test/PlutusIR/TypeCheck/nonrec1.golden | 2 +- .../test/PlutusIR/TypeCheck/nonrec2.golden | 2 +- .../test/PlutusIR/TypeCheck/nonrec3.golden | 2 +- .../test/PlutusIR/TypeCheck/nonrec4.golden | 2 +- .../test/PlutusIR/TypeCheck/nonrec6.golden | 2 +- .../test/PlutusIR/TypeCheck/nonrec7.golden | 2 +- .../test/PlutusIR/TypeCheck/nonrec8.golden | 2 +- .../PlutusIR/TypeCheck/nonrecToNonrec.golden | 2 +- .../PlutusIR/TypeCheck/nonrecToRec.golden | 2 +- .../test/PlutusIR/TypeCheck/oldLength.golden | 2 +- .../test/PlutusIR/TypeCheck/rec1.golden | 2 +- .../test/PlutusIR/TypeCheck/rec2.golden | 2 +- .../test/PlutusIR/TypeCheck/rec3.golden | 2 +- .../test/PlutusIR/TypeCheck/rec4.golden | 2 +- .../TypeCheck/sameNameDifferentEnv.golden | 2 +- .../PlutusIR/TypeCheck/strictNonValue.golden | 2 +- .../PlutusIR/TypeCheck/strictNonValue2.golden | 2 +- .../PlutusIR/TypeCheck/strictNonValue3.golden | 2 +- .../TypeCheck/strictNonValueDeep.golden | 2 +- .../PlutusIR/TypeCheck/strictValue.golden | 2 +- .../TypeCheck/strictValueNonValue.golden | 2 +- .../TypeCheck/strictValueValue.golden | 2 +- .../test/PlutusIR/TypeCheck/typeLet.golden | 2 +- .../test/PlutusIR/TypeCheck/typeLetRec.golden | 2 +- .../PlutusIR/TypeCheck/typeLetWrong.golden | 2 +- .../wrongDataConstrReturnType.golden | 2 +- .../test/Analysis/evalOrder/letFun.golden | 10 +- .../test/Analysis/evalOrder/letImpure.golden | 6 +- .../Golden/Default/okConst.uplc.golden | 4 +- .../Golden/Default/okDeep0.uplc.golden | 11 +- .../Golden/Default/okDeep99.uplc.golden | 11 +- .../DeBruijn/Golden/Default/okId0.uplc.golden | 2 +- .../Golden/Default/okId99.uplc.golden | 2 +- .../Golden/Default/okMix1.uplc.golden | 38 +- .../Golden/Default/okMix2.uplc.golden | 38 +- .../Golden/Graceful/graceConst.uplc.golden | 4 +- .../Golden/Graceful/graceDeep.uplc.golden | 2 +- .../Graceful/graceElaborate.uplc.golden | 4 +- .../Golden/Graceful/graceTop.uplc.golden | 2 +- .../Golden/List/headList-empty.err.golden | 2 +- .../Golden/List/tailList-empty.err.golden | 2 +- .../consByteString-out-of-range.err.golden | 2 +- ...xByteString-out-of-bounds-empty.err.golden | 2 +- ...eString-out-of-bounds-non-empty.err.golden | 2 +- .../test/Evaluation/Golden/closure.plc.golden | 2 +- .../Evaluation/Golden/closure.uplc.golden | 2 +- .../test/Evaluation/Golden/ite.type.golden | 2 +- .../Golden/iteAtHigherKind.type.golden | 2 +- .../iteAtHigherKindFullyApplied.type.golden | 2 +- .../iteAtHigherKindWithCond.type.golden | 2 +- .../iteUninstantiatedFullyApplied.type.golden | 2 +- .../iteUninstantiatedWithCond.type.golden | 2 +- .../Evaluation/Golden/polyError.type.golden | 2 +- .../Machines/Budget/IdNat/0.uplc.golden | 88 +- .../Machines/Budget/IdNat/3.uplc.golden | 88 +- .../Machines/Budget/IdNat/6.uplc.golden | 88 +- .../Machines/Budget/IdNat/9.uplc.golden | 88 +- .../Machines/Budget/IfThenElse/0.uplc.golden | 88 +- .../Machines/Budget/IfThenElse/1.uplc.golden | 88 +- .../Machines/Budget/IfThenElse/2.uplc.golden | 88 +- .../Machines/Budget/IfThenElse/3.uplc.golden | 88 +- .../Machines/Budget/IfThenElse/4.uplc.golden | 88 +- .../Machines/Budget/IfThenElse/5.uplc.golden | 88 +- .../test/Transform/CaseOfCase/1.uplc.golden | 2 +- .../test/Transform/CaseOfCase/2.uplc.golden | 2 +- .../test/Transform/CaseOfCase/3.uplc.golden | 6 +- .../test/Transform/callsiteInline.uplc.golden | 2 +- .../test/Transform/cse1.uplc.golden | 24 +- .../test/Transform/cse2.uplc.golden | 12 +- .../test/Transform/cse3.uplc.golden | 10 +- .../test/Transform/cseExpensive.uplc.golden | 2340 ++-- .../test/Transform/extraDelays.uplc.golden | 2 +- .../test/Transform/floatDelay1.uplc.golden | 2 +- .../test/Transform/floatDelay2.uplc.golden | 2 +- .../test/Transform/floatDelay3.uplc.golden | 2 +- .../Transform/forceDelayComplex.uplc.golden | 2 +- .../forceDelayMultiApply.uplc.golden | 2 +- .../test/Transform/inlineImpure1.uplc.golden | 2 +- .../test/Transform/inlineImpure2.uplc.golden | 2 +- .../test/Transform/inlineImpure3.uplc.golden | 2 +- .../test/Transform/inlineImpure4.uplc.golden | 2 +- .../test/Transform/inlinePure1.uplc.golden | 2 +- .../test/Transform/inlinePure2.uplc.golden | 2 +- .../test/Transform/inlinePure3.uplc.golden | 2 +- .../test/Transform/inlinePure4.uplc.golden | 2 +- .../Transform/interveningLambda.uplc.golden | 2 +- .../test/Transform/multiApp.uplc.golden | 2 +- .../Budget/9.6/onlyUseFirstField.uplc.golden | 56 +- .../Budget/9.6/patternMatching.uplc.golden | 139 +- .../9.6/recordFields-manual.uplc.golden | 219 +- .../Budget/9.6/recordFields.uplc.golden | 152 +- .../test/Budget/9.6/allCheap.uplc.golden | 78 +- .../test/Budget/9.6/allEmptyList.uplc.golden | 34 +- .../test/Budget/9.6/allExpensive.uplc.golden | 78 +- .../test/Budget/9.6/andCheap.uplc.golden | 70 +- .../test/Budget/9.6/andExpensive.uplc.golden | 70 +- .../Budget/9.6/andWithGHCOpts.uplc.golden | 32 +- .../test/Budget/9.6/andWithLocal.uplc.golden | 30 +- .../Budget/9.6/andWithoutGHCOpts.uplc.golden | 28 +- .../test/Budget/9.6/anyCheap.uplc.golden | 78 +- .../test/Budget/9.6/anyEmptyList.uplc.golden | 34 +- .../test/Budget/9.6/anyExpensive.uplc.golden | 78 +- .../test/Budget/9.6/applicative.uplc.golden | 2 +- .../9.6/builtinListIndexing.uplc.golden | 42 +- .../test/Budget/9.6/constAccL.uplc.golden | 40 +- .../test/Budget/9.6/constAccR.uplc.golden | 32 +- .../test/Budget/9.6/constElL.uplc.golden | 40 +- .../test/Budget/9.6/constElR.uplc.golden | 34 +- .../test/Budget/9.6/elemCheap.uplc.golden | 78 +- .../test/Budget/9.6/elemExpensive.uplc.golden | 78 +- .../test/Budget/9.6/filter.uplc.golden | 82 +- .../test/Budget/9.6/findCheap.uplc.golden | 78 +- .../test/Budget/9.6/findEmptyList.uplc.golden | 34 +- .../test/Budget/9.6/findExpensive.uplc.golden | 78 +- .../Budget/9.6/findIndexCheap.uplc.golden | 81 +- .../Budget/9.6/findIndexEmptyList.uplc.golden | 37 +- .../Budget/9.6/findIndexExpensive.uplc.golden | 81 +- .../test/Budget/9.6/gte0.uplc.golden | 56 +- .../test/Budget/9.6/ifThenElse1.uplc.golden | 2 +- .../test/Budget/9.6/ifThenElse2.uplc.golden | 2 +- .../test/Budget/9.6/listIndexing.uplc.golden | 42 +- .../test/Budget/9.6/lte0.uplc.golden | 56 +- .../test/Budget/9.6/map1.uplc.golden | 944 +- .../test/Budget/9.6/map2.uplc.golden | 509 +- .../test/Budget/9.6/map3.uplc.golden | 509 +- .../test/Budget/9.6/monadicDo.uplc.golden | 20 +- .../test/Budget/9.6/not-not.uplc.golden | 26 +- .../test/Budget/9.6/notElemCheap.uplc.golden | 78 +- .../Budget/9.6/notElemExpensive.uplc.golden | 78 +- .../test/Budget/9.6/null.uplc.golden | 2 +- .../test/Budget/9.6/orCheap.uplc.golden | 70 +- .../test/Budget/9.6/orExpensive.uplc.golden | 70 +- .../test/Budget/9.6/patternMatch.uplc.golden | 2 +- .../test/Budget/9.6/recursiveGte0.uplc.golden | 91 +- .../test/Budget/9.6/recursiveLte0.uplc.golden | 91 +- .../test/Budget/9.6/show.uplc.golden | 1000 +- .../test/Budget/9.6/sum.uplc.golden | 70 +- .../test/Budget/9.6/sumL.uplc.golden | 58 +- .../test/Budget/9.6/sumR.uplc.golden | 47 +- .../test/Budget/9.6/toFromData.uplc.golden | 412 +- ...erals-NoStrict-NegativeLiterals.pir.golden | 53 +- ...als-NoStrict-NoNegativeLiterals.pir.golden | 53 +- ...iterals-Strict-NegativeLiterals.pir.golden | 53 +- ...erals-Strict-NoNegativeLiterals.pir.golden | 53 +- .../test/IsData/9.6/bytestring.eval.golden | 2 +- .../test/IsData/9.6/int.eval.golden | 2 +- .../test/IsData/9.6/list.eval.golden | 2 +- .../test/IsData/9.6/matchAsDataE.eval.golden | 2 +- .../test/IsData/9.6/mono.eval.golden | 2 +- .../test/IsData/9.6/nested.eval.golden | 2 +- .../test/IsData/9.6/poly.eval.golden | 2 +- .../test/IsData/9.6/record.eval.golden | 2 +- .../test/IsData/9.6/tuple.eval.golden | 2 +- .../test/IsData/9.6/tupleInterop.eval.golden | 2 +- .../test/IsData/9.6/unit.eval.golden | 2 +- .../test/IsData/9.6/unitInterop.eval.golden | 2 +- .../IsData/9.6/unsafeTupleInterop.eval.golden | 2 +- .../test/Lift/9.6/boolInterop.eval.golden | 2 +- .../test/Lift/9.6/bytestring.uplc.golden | 37 +- .../test/Lift/9.6/int.uplc.golden | 2 +- .../test/Lift/9.6/list.uplc.golden | 53 +- .../test/Lift/9.6/listInterop.eval.golden | 2 +- .../test/Lift/9.6/mono.uplc.golden | 75 +- .../test/Lift/9.6/monoInterop.eval.golden | 2 +- .../test/Lift/9.6/nested.uplc.golden | 143 +- .../test/Lift/9.6/newtypeInt.uplc.golden | 2 +- .../test/Lift/9.6/newtypeInt2.uplc.golden | 2 +- .../test/Lift/9.6/newtypeInt3.uplc.golden | 2 +- .../test/Lift/9.6/poly.uplc.golden | 77 +- .../test/Lift/9.6/polyInterop.eval.golden | 2 +- .../test/Lift/9.6/record.uplc.golden | 46 +- .../test/Lift/9.6/syn.uplc.golden | 64 +- .../test/Lift/9.6/tuple.uplc.golden | 57 +- .../Optimization/9.6/maybeFun.uplc.golden | 42 +- .../9.6/defaultCaseDuplication.pir.golden | 47 +- .../defaultCaseDuplicationNested.pir.golden | 86 +- .../test/Plugin/Basic/9.6/ifOpt.pir.golden | 112 +- .../Plugin/Basic/9.6/ifOptEval.eval.golden | 2 +- .../test/Plugin/Basic/9.6/letFun.pir.golden | 86 +- .../Plugin/Basic/9.6/monadicDo.pir.golden | 174 +- .../test/Plugin/Basic/9.6/monoId.pir.golden | 2 +- .../test/Plugin/Basic/9.6/monoK.pir.golden | 13 +- .../Plugin/Basic/9.6/nonstrictLet.pir.golden | 69 +- .../Basic/9.6/patternMatchDo.pir.golden | 214 +- .../Plugin/Basic/9.6/strictLet.pir.golden | 69 +- .../Plugin/Basic/9.6/strictLetRec.pir.golden | 87 +- .../Basic/9.6/strictMultiLet.pir.golden | 71 +- .../Coverage/9.6/coverageCode.pir.golden | 701 +- .../Data/9.6/families/associated.pir.golden | 2 +- .../9.6/families/associatedParam.pir.golden | 49 +- .../Data/9.6/families/basicClosed.pir.golden | 2 +- .../Data/9.6/families/basicData.pir.golden | 33 +- .../Data/9.6/families/basicOpen.pir.golden | 2 +- .../Data/9.6/monomorphic/atPattern.pir.golden | 62 +- .../9.6/monomorphic/defaultCase.pir.golden | 52 +- .../Data/9.6/monomorphic/enum.pir.golden | 19 +- .../monomorphic/irrefutableMatch.pir.golden | 71 +- .../Data/9.6/monomorphic/monoCase.pir.golden | 46 +- .../9.6/monomorphic/monoCaseStrict.pir.golden | 46 +- .../9.6/monomorphic/monoConstDest.eval.golden | 2 +- .../monoConstDestDefault.eval.golden | 2 +- .../monomorphic/monoConstructed.pir.golden | 37 +- .../monomorphic/monoConstructor.pir.golden | 53 +- .../9.6/monomorphic/monoDataType.pir.golden | 52 +- .../9.6/monomorphic/monoRecord.pir.golden | 28 +- .../9.6/monomorphic/nonValueCase.pir.golden | 62 +- .../9.6/monomorphic/recordNewtype.pir.golden | 25 +- .../recordWithStrictField.pir.golden | 56 +- .../monomorphic/strictDataMatch.pir.golden | 54 +- .../Data/9.6/monomorphic/synonym.pir.golden | 2 +- .../9.6/monomorphic/unusedWrapper.pir.golden | 64 +- .../Data/9.6/newtypes/basicNewtype.pir.golden | 2 +- .../newtypes/nestedNewtypeMatch.pir.golden | 2 +- .../9.6/newtypes/newtypeCreatDest.eval.golden | 2 +- .../9.6/newtypes/newtypeCreate.pir.golden | 2 +- .../9.6/newtypes/newtypeCreate2.pir.golden | 2 +- .../Data/9.6/newtypes/newtypeId.pir.golden | 2 +- .../Data/9.6/newtypes/newtypeMatch.pir.golden | 2 +- .../Data/9.6/newtypes/paramNewtype.pir.golden | 37 +- .../polymorphic/defaultCasePoly.pir.golden | 49 +- .../polymorphic/polyConstructed.pir.golden | 66 +- .../9.6/polymorphic/polyDataType.pir.golden | 49 +- .../recursive/interListConstruct.tplc.golden | 316 +- .../9.6/recursive/listConstDest.eval.golden | 2 +- .../9.6/recursive/listConstDest2.eval.golden | 2 +- .../9.6/recursive/listConstruct.pir.golden | 22 +- .../9.6/recursive/listConstruct2.pir.golden | 68 +- .../9.6/recursive/listConstruct3.pir.golden | 28 +- .../Data/9.6/recursive/listMatch.pir.golden | 43 +- .../9.6/recursive/polyRecEval.eval.golden | 2 +- .../processInterListEval.eval.golden | 2 +- .../9.6/recursive/ptreeConstDest.eval.golden | 2 +- .../9.6/recursive/ptreeConstruct.pir.golden | 129 +- .../9.6/recursive/ptreeFirstEval.eval.golden | 2 +- .../Data/9.6/recursive/ptreeMatch.pir.golden | 57 +- .../9.6/recursive/sameEmptyRose.uplc.golden | 793 +- .../recursive/sameEmptyRoseEval.eval.golden | 7 +- .../test/Plugin/Debug/9.6/fib.pir.golden | 156 +- .../test/Plugin/Debug/9.6/letFun.pir.golden | 72 +- .../Errors/9.6/literalAppendBs.uplc.golden | 34 +- .../Functions/9.6/recursive/even.pir.golden | 183 +- .../Functions/9.6/recursive/even3.eval.golden | 2 +- .../Functions/9.6/recursive/even4.eval.golden | 2 +- .../Functions/9.6/recursive/fib.pir.golden | 212 +- .../Functions/9.6/recursive/fib4.eval.golden | 2 +- .../9.6/recursive/lazyLength.pir.golden | 146 +- .../9.6/recursive/strictLength.pir.golden | 146 +- .../Functions/9.6/recursive/sum.pir.golden | 94 +- .../9.6/recursive/sumList.eval.golden | 2 +- .../9.6/unfoldings/allDirect.pir.golden | 329 +- .../9.6/unfoldings/andDirect.pir.golden | 116 +- .../9.6/unfoldings/andExternal.pir.golden | 64 +- .../unfoldings/applicationFunction.pir.golden | 89 +- .../mutualRecursionUnfoldings.pir.golden | 136 +- .../9.6/unfoldings/nandDirect.pir.golden | 83 +- .../9.6/unfoldings/polyMap.pir.golden | 202 +- .../9.6/unfoldings/recordSelector.pir.golden | 39 +- .../recordSelectorExternal.pir.golden | 41 +- .../9.6/unfoldings/unboxedTuples2.pir.golden | 89 +- .../unboxedTuples2Tuples.pir.golden | 386 +- .../9.6/unfoldings/unboxedTuples3.pir.golden | 118 +- .../unboxedTuples3Tuples.pir.golden | 486 +- .../9.6/unfoldings/unboxedTuples4.pir.golden | 156 +- .../9.6/unfoldings/unboxedTuples5.pir.golden | 201 +- .../Plugin/Laziness/9.6/joinError.pir.golden | 96 +- .../Laziness/9.6/joinErrorEval.eval.golden | 2 +- .../Laziness/9.6/lazyDepUnit.pir.golden | 28 +- .../Optimization/9.6/alwaysFails.uplc.golden | 2 +- .../9.6/alwaysSucceeds.uplc.golden | 2 +- .../test/Plugin/Primitives/9.6/and.pir.golden | 57 +- .../Primitives/9.6/andApply.eval.golden | 2 +- .../Plugin/Primitives/9.6/bool.pir.golden | 19 +- .../Primitives/9.6/bytestring.pir.golden | 2 +- .../9.6/bytestringApply.eval.golden | 2 +- .../Primitives/9.6/consByteString.eval.golden | 2 +- .../Primitives/9.6/constructData1.eval.golden | 2 +- .../Primitives/9.6/decodeUtf8.eval.golden | 2 +- .../9.6/deconstructData1.eval.golden | 2 +- .../9.6/deconstructData2.eval.golden | 6 +- .../9.6/deconstructData3.eval.golden | 2 +- .../9.6/deconstructorData1.pir.golden | 37 +- .../9.6/deconstructorData2.pir.golden | 607 +- .../Primitives/9.6/emptyByteString.pir.golden | 2 +- .../9.6/emptyByteStringApply.eval.golden | 2 +- .../Primitives/9.6/encodeUtf8.pir.golden | 20 +- .../9.6/equalsByteString.eval.golden | 2 +- .../Primitives/9.6/equalsString.eval.golden | 2 +- .../Plugin/Primitives/9.6/error.pir.golden | 24 +- .../Primitives/9.6/ifThenElse.pir.golden | 107 +- .../9.6/ifThenElseApply.eval.golden | 2 +- .../9.6/indexByteString.eval.golden | 2 +- .../test/Plugin/Primitives/9.6/int.pir.golden | 2 +- .../Plugin/Primitives/9.6/int2.pir.golden | 2 +- .../Primitives/9.6/intCompare.pir.golden | 88 +- .../Plugin/Primitives/9.6/intDiv.pir.golden | 65 +- .../Plugin/Primitives/9.6/intEq.pir.golden | 86 +- .../Primitives/9.6/intEqApply.eval.golden | 2 +- .../Plugin/Primitives/9.6/intPlus.pir.golden | 61 +- .../Primitives/9.6/intPlusApply.eval.golden | 2 +- .../9.6/lengthOfByteString.eval.golden | 2 +- .../Primitives/9.6/ltByteString.eval.golden | 2 +- .../Primitives/9.6/matchData1.eval.golden | 2 +- .../Primitives/9.6/serialiseData.pir.golden | 20 +- .../9.6/serialiseDataApply.eval.golden | 2 +- .../Primitives/9.6/sha2_256.eval.golden | 4 +- .../Plugin/Primitives/9.6/string.pir.golden | 2 +- .../Primitives/9.6/stringLiteral.pir.golden | 2 +- .../Plugin/Primitives/9.6/trace.pir.golden | 33 +- .../Primitives/9.6/traceComplex.pir.golden | 94 +- .../Plugin/Primitives/9.6/tuple.pir.golden | 21 +- .../Primitives/9.6/tupleConstDest.eval.golden | 2 +- .../Primitives/9.6/tupleMatch.pir.golden | 31 +- .../Plugin/Primitives/9.6/verify.pir.golden | 130 +- .../Plugin/Primitives/9.6/void.pir.golden | 131 +- .../Plugin/Profiling/9.6/addInt.pir.golden | 115 +- .../Plugin/Profiling/9.6/addInt3.eval.golden | 2 +- .../Profiling/9.6/argMismatch1.eval.golden | 12 +- .../Profiling/9.6/argMismatch2.eval.golden | 2 +- .../Plugin/Profiling/9.6/fact4.eval.golden | 72 +- .../test/Plugin/Profiling/9.6/fib.pir.golden | 343 +- .../Plugin/Profiling/9.6/fib4.eval.golden | 148 +- .../test/Plugin/Profiling/9.6/id.eval.golden | 2 +- .../Plugin/Profiling/9.6/idCode.pir.golden | 42 +- .../Plugin/Profiling/9.6/letInFun.eval.golden | 20 +- .../Profiling/9.6/letInFunMoreArg.eval.golden | 24 +- .../Profiling/9.6/letRecInFun.eval.golden | 56 +- .../Plugin/Profiling/9.6/swap.eval.golden | 2 +- .../Profiling/9.6/typeclass.eval.golden | 24 +- .../Typeclasses/9.6/compareTest.pir.golden | 650 +- .../Typeclasses/9.6/concatTest.pir.golden | 451 +- .../Typeclasses/9.6/defaultMethods.pir.golden | 138 +- .../9.6/fmapDefaultTest.pir.golden | 1075 +- .../Typeclasses/9.6/multiFunction.pir.golden | 294 +- .../9.6/partialApplication.pir.golden | 144 +- .../Typeclasses/9.6/sequenceTest.pir.golden | 1151 +- .../Typeclasses/9.6/sizedBasic.pir.golden | 48 +- .../Typeclasses/9.6/sizedPair.pir.golden | 207 +- .../Plugin/Typeclasses/9.6/sumTest.pir.golden | 410 +- .../test/StdLib/9.6/errorTrace.pir.golden | 53 +- .../test/StdLib/9.6/ratioInterop.eval.golden | 1 - .../Strictness/9.6/lambda-default.uplc.golden | 2 +- .../9.6/lambda-nonstrict.uplc.golden | 2 +- .../Strictness/9.6/lambda-strict.uplc.golden | 2 +- .../Strictness/9.6/let-default.uplc.golden | 18 +- .../Strictness/9.6/let-nonstrict.uplc.golden | 18 +- .../Strictness/9.6/let-strict.uplc.golden | 18 +- 562 files changed, 24288 insertions(+), 34577 deletions(-) delete mode 100644 plutus-tx-plugin/test/StdLib/9.6/ratioInterop.eval.golden diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden index 46dc8d51161..170fe68030c 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.pir.golden @@ -1,5375 +1,5800 @@ -(program - 1.1.0 - (let - data Ordering | Ordering_match where - EQ : Ordering - GT : Ordering - LT : Ordering - data Bool | Bool_match where - True : Bool - False : Bool - data (Ord :: * -> *) a | Ord_match where - CConsOrd : - (\a -> a -> a -> Bool) a -> - (a -> a -> Ordering) -> - (a -> a -> Bool) -> - (a -> a -> Bool) -> - (a -> a -> Bool) -> - (a -> a -> Bool) -> - (a -> a -> a) -> - (a -> a -> a) -> - Ord a - data PredKey | PredKey_match where - MaxValue : PredKey - MinValue : PredKey - NotEqual : PredKey - data (Tuple2 :: * -> * -> *) a b | Tuple2_match where - Tuple2 : a -> b -> Tuple2 a b - in - letrec - data (List :: * -> *) a | List_match where - Nil : List a - Cons : a -> List a -> List a - in - let - !validatePreds : - all a. Ord a -> (\v -> List (Tuple2 PredKey (List v))) a -> a -> Bool - = /\a -> - \(`$dOrd` : Ord a) - (ds : (\v -> List (Tuple2 PredKey (List v))) a) - (ds : a) -> - letrec - !go : List (Tuple2 PredKey (List a)) -> Bool - = \(ds : List (Tuple2 PredKey (List a))) -> - List_match - {Tuple2 PredKey (List a)} - ds - {all dead. Bool} - (/\dead -> True) - (\(x : Tuple2 PredKey (List a)) - (xs : List (Tuple2 PredKey (List a))) -> - /\dead -> - Tuple2_match - {PredKey} - {List a} - x - {Bool} - (\(predKey : PredKey) - (expectedPredValues : List a) -> - let - !meaning : a -> a -> Bool - = PredKey_match - predKey - {all dead. a -> a -> Bool} - (/\dead -> - Ord_match - {a} - `$dOrd` - {a -> a -> Bool} - (\(v : (\a -> a -> a -> Bool) a) - (v : a -> a -> Ordering) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> a) - (v : a -> a -> a) -> - v)) - (/\dead -> - Ord_match - {a} - `$dOrd` - {a -> a -> Bool} - (\(v : (\a -> a -> a -> Bool) a) - (v : a -> a -> Ordering) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> a) - (v : a -> a -> a) -> - v)) - (/\dead -> - \(x : a) (y : a) -> - Bool_match - (Ord_match - {a} - `$dOrd` - {(\a -> a -> a -> Bool) a} - (\(v : - (\a -> a -> a -> Bool) - a) - (v : a -> a -> Ordering) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> a) - (v : a -> a -> a) -> - v) - x - y) - {all dead. Bool} - (/\dead -> False) - (/\dead -> True) - {all dead. dead}) - {all dead. dead} - in - letrec - !go : List a -> Bool - = \(ds : List a) -> - List_match - {a} - ds - {all dead. Bool} - (/\dead -> go xs) - (\(x : a) (xs : List a) -> - /\dead -> - Bool_match - (meaning x ds) - {all dead. Bool} - (/\dead -> go xs) - (/\dead -> False) - {all dead. dead}) - {all dead. dead} - in - go expectedPredValues)) - {all dead. dead} +program + 1.1.0 + (let + data Ordering-73055 | Ordering_match-73059 where + EQ-73056 : Ordering-73055 + GT-73057 : Ordering-73055 + LT-73058 : Ordering-73055 + data Bool-73046 | Bool_match-73049 where + True-73047 : Bool-73046 + False-73048 : Bool-73046 + data (Ord-73060 :: * -> *) a-73063 | Ord_match-73062 where + CConsOrd-73061 : + (\a-73064 -> a-73064 -> a-73064 -> Bool-73046) a-73063 -> + (a-73063 -> a-73063 -> Ordering-73055) -> + (a-73063 -> a-73063 -> Bool-73046) -> + (a-73063 -> a-73063 -> Bool-73046) -> + (a-73063 -> a-73063 -> Bool-73046) -> + (a-73063 -> a-73063 -> Bool-73046) -> + (a-73063 -> a-73063 -> a-73063) -> + (a-73063 -> a-73063 -> a-73063) -> + Ord-73060 a-73063 + data PredKey-73050 | PredKey_match-73054 where + MaxValue-73051 : PredKey-73050 + MinValue-73052 : PredKey-73050 + NotEqual-73053 : PredKey-73050 + data (Tuple2-73031 :: * -> * -> *) a-73034 + b-73035 | Tuple2_match-73033 where + Tuple2-73032 : a-73034 -> b-73035 -> Tuple2-73031 a-73034 b-73035 + in + letrec + data (List-73026 :: * -> *) a-73030 | List_match-73029 where + Nil-73027 : List-73026 a-73030 + Cons-73028 : a-73030 -> List-73026 a-73030 -> List-73026 a-73030 + in + let + !validatePreds-73196 : + all a-73197. + Ord-73060 a-73197 -> + (\v-73198 -> + List-73026 (Tuple2-73031 PredKey-73050 (List-73026 v-73198))) + a-73197 -> + a-73197 -> + Bool-73046 + = /\a-73129 -> + \(`$dOrd`-73130 : Ord-73060 a-73129) + (ds-73131 : + (\v-73132 -> + List-73026 (Tuple2-73031 PredKey-73050 (List-73026 v-73132))) + a-73129) + (ds-73133 : a-73129) -> + letrec + !go-73134 : + List-73026 (Tuple2-73031 PredKey-73050 (List-73026 a-73129)) -> + Bool-73046 + = \(ds-73135 : + List-73026 + (Tuple2-73031 PredKey-73050 (List-73026 a-73129))) -> + List_match-73029 + {Tuple2-73031 PredKey-73050 (List-73026 a-73129)} + ds-73135 + {all dead-73136. Bool-73046} + (/\dead-73137 -> True-73047) + (\(x-73138 : + Tuple2-73031 PredKey-73050 (List-73026 a-73129)) + (xs-73139 : + List-73026 + (Tuple2-73031 + PredKey-73050 + (List-73026 a-73129))) -> + /\dead-73140 -> + Tuple2_match-73033 + {PredKey-73050} + {List-73026 a-73129} + x-73138 + {Bool-73046} + (\(predKey-73141 : PredKey-73050) + (expectedPredValues-73142 : + List-73026 a-73129) -> + let + !meaning-73182 : + a-73129 -> a-73129 -> Bool-73046 + = PredKey_match-73054 + predKey-73141 + {all dead-73143. + a-73129 -> a-73129 -> Bool-73046} + (/\dead-73144 -> + Ord_match-73062 + {a-73129} + `$dOrd`-73130 + {a-73129 -> a-73129 -> Bool-73046} + (\(v-73145 : + (\a-73146 -> + a-73146 -> + a-73146 -> + Bool-73046) + a-73129) + (v-73147 : + a-73129 -> + a-73129 -> + Ordering-73055) + (v-73148 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73149 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73150 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73151 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73152 : + a-73129 -> a-73129 -> a-73129) + (v-73153 : + a-73129 -> + a-73129 -> + a-73129) -> + v-73151)) + (/\dead-73154 -> + Ord_match-73062 + {a-73129} + `$dOrd`-73130 + {a-73129 -> a-73129 -> Bool-73046} + (\(v-73155 : + (\a-73156 -> + a-73156 -> + a-73156 -> + Bool-73046) + a-73129) + (v-73157 : + a-73129 -> + a-73129 -> + Ordering-73055) + (v-73158 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73159 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73160 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73161 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73162 : + a-73129 -> a-73129 -> a-73129) + (v-73163 : + a-73129 -> + a-73129 -> + a-73129) -> + v-73159)) + (/\dead-73164 -> + \(x-73165 : a-73129) + (y-73166 : a-73129) -> + Bool_match-73049 + (Ord_match-73062 + {a-73129} + `$dOrd`-73130 + {(\a-73167 -> + a-73167 -> + a-73167 -> + Bool-73046) + a-73129} + (\(v-73168 : + (\a-73169 -> + a-73169 -> + a-73169 -> + Bool-73046) + a-73129) + (v-73170 : + a-73129 -> + a-73129 -> + Ordering-73055) + (v-73171 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73172 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73173 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73174 : + a-73129 -> + a-73129 -> + Bool-73046) + (v-73175 : + a-73129 -> + a-73129 -> + a-73129) + (v-73176 : + a-73129 -> + a-73129 -> + a-73129) -> + v-73168) + x-73165 + y-73166) + {all dead-73177. Bool-73046} + (/\dead-73178 -> False-73048) + (/\dead-73179 -> True-73047) + {all dead-73180. dead-73180}) + {all dead-73181. dead-73181} + in + letrec + !go-73183 : List-73026 a-73129 -> Bool-73046 + = \(ds-73184 : List-73026 a-73129) -> + List_match-73029 + {a-73129} + ds-73184 + {all dead-73185. Bool-73046} + (/\dead-73186 -> go-73134 xs-73139) + (\(x-73187 : a-73129) + (xs-73188 : List-73026 a-73129) -> + /\dead-73189 -> + Bool_match-73049 + (meaning-73182 + x-73187 + ds-73133) + {all dead-73190. Bool-73046} + (/\dead-73191 -> + go-73183 xs-73188) + (/\dead-73192 -> False-73048) + {all dead-73193. dead-73193}) + {all dead-73194. dead-73194} + in + go-73183 expectedPredValues-73142)) + {all dead-73195. dead-73195} + in + go-73134 ds-73131 + !`$fOrdInteger_$ccompare`-73115 : integer -> integer -> Ordering-73055 + = \(eta-73105 : integer) (eta-73106 : integer) -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (equalsInteger eta-73105 eta-73106) + True-73047 + False-73048) + {all dead-73107. Ordering-73055} + (/\dead-73108 -> EQ-73056) + (/\dead-73109 -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (lessThanEqualsInteger eta-73105 eta-73106) + True-73047 + False-73048) + {all dead-73110. Ordering-73055} + (/\dead-73111 -> LT-73058) + (/\dead-73112 -> GT-73057) + {all dead-73113. dead-73113}) + {all dead-73114. dead-73114} + data Rational-73065 | Rational_match-73067 where + Rational-73066 : integer -> integer -> Rational-73065 + !`$fOrdRational0_$c<=`-73104 : + Rational-73065 -> Rational-73065 -> Bool-73046 + = \(ds-73098 : Rational-73065) (ds-73099 : Rational-73065) -> + Rational_match-73067 + ds-73098 + {Bool-73046} + (\(n-73100 : integer) (d-73101 : integer) -> + Rational_match-73067 + ds-73099 + {Bool-73046} + (\(n'-73102 : integer) (d'-73103 : integer) -> + ifThenElse + {Bool-73046} + (lessThanEqualsInteger + (multiplyInteger n-73100 d'-73103) + (multiplyInteger n'-73102 d-73101)) + True-73047 + False-73048)) + in + letrec + !euclid-73079 : integer -> integer -> integer + = \(x-73080 : integer) (y-73081 : integer) -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (equalsInteger 0 y-73081) + True-73047 + False-73048) + {all dead-73082. integer} + (/\dead-73083 -> x-73080) + (/\dead-73084 -> euclid-73079 y-73081 (modInteger x-73080 y-73081)) + {all dead-73085. dead-73085} + in + letrec + !unsafeRatio-73086 : integer -> integer -> Rational-73065 + = \(n-73087 : integer) (d-73088 : integer) -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (equalsInteger 0 d-73088) + True-73047 + False-73048) + {all dead-73089. Rational-73065} + (/\dead-73090 -> error {Rational-73065}) + (/\dead-73091 -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (lessThanInteger d-73088 0) + True-73047 + False-73048) + {all dead-73092. Rational-73065} + (/\dead-73093 -> + unsafeRatio-73086 + (subtractInteger 0 n-73087) + (subtractInteger 0 d-73088)) + (/\dead-73094 -> + let + !gcd'-73095 : integer = euclid-73079 n-73087 d-73088 + in + Rational-73066 + (quotientInteger n-73087 gcd'-73095) + (quotientInteger d-73088 gcd'-73095)) + {all dead-73096. dead-73096}) + {all dead-73097. dead-73097} + in + let + data Unit-73076 | Unit_match-73078 where + Unit-73077 : Unit-73076 + in + letrec + data ParamValue-73068 | ParamValue_match-73073 where + ParamAny-73069 : ParamValue-73068 + ParamInteger-73070 : + (\v-73074 -> + List-73026 (Tuple2-73031 PredKey-73050 (List-73026 v-73074))) + integer -> + ParamValue-73068 + ParamList-73071 : List-73026 ParamValue-73068 -> ParamValue-73068 + ParamRational-73072 : + (\v-73075 -> + List-73026 (Tuple2-73031 PredKey-73050 (List-73026 v-73075))) + Rational-73065 -> + ParamValue-73068 + in + letrec + !validateParamValue-73116 : ParamValue-73068 -> data -> Bool-73046 + = \(eta-73117 : ParamValue-73068) (eta-73118 : data) -> + let + ~bl-73277 : list data = unListData eta-73118 + ~bl'-73278 : list data = tailList {data} bl-73277 + in + ParamValue_match-73073 + eta-73117 + {all dead-73199. Bool-73046} + (/\dead-73200 -> True-73047) + (\(preds-73201 : + (\v-73202 -> + List-73026 + (Tuple2-73031 PredKey-73050 (List-73026 v-73202))) + integer) -> + /\dead-73203 -> + validatePreds-73196 + {integer} + (CConsOrd-73061 + {integer} + (\(x-73204 : integer) (y-73205 : integer) -> + ifThenElse + {Bool-73046} + (equalsInteger x-73204 y-73205) + True-73047 + False-73048) + `$fOrdInteger_$ccompare`-73115 + (\(x-73206 : integer) (y-73207 : integer) -> + ifThenElse + {Bool-73046} + (lessThanInteger x-73206 y-73207) + True-73047 + False-73048) + (\(x-73208 : integer) (y-73209 : integer) -> + ifThenElse + {Bool-73046} + (lessThanEqualsInteger x-73208 y-73209) + True-73047 + False-73048) + (\(x-73210 : integer) (y-73211 : integer) -> + ifThenElse + {Bool-73046} + (lessThanEqualsInteger x-73210 y-73211) + False-73048 + True-73047) + (\(x-73212 : integer) (y-73213 : integer) -> + ifThenElse + {Bool-73046} + (lessThanInteger x-73212 y-73213) + False-73048 + True-73047) + (\(x-73214 : integer) (y-73215 : integer) -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (lessThanEqualsInteger x-73214 y-73215) + True-73047 + False-73048) + {all dead-73216. integer} + (/\dead-73217 -> y-73215) + (/\dead-73218 -> x-73214) + {all dead-73219. dead-73219}) + (\(x-73220 : integer) (y-73221 : integer) -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (lessThanEqualsInteger x-73220 y-73221) + True-73047 + False-73048) + {all dead-73222. integer} + (/\dead-73223 -> x-73220) + (/\dead-73224 -> y-73221) + {all dead-73225. dead-73225})) + preds-73201 + (unIData eta-73118)) + (\(paramValues-73226 : List-73026 ParamValue-73068) -> + /\dead-73227 -> + validateParamValues-73119 + paramValues-73226 + (unListData eta-73118)) + (\(preds-73228 : + (\v-73229 -> + List-73026 + (Tuple2-73031 PredKey-73050 (List-73026 v-73229))) + Rational-73065) -> + /\dead-73230 -> + validatePreds-73196 + {Rational-73065} + (CConsOrd-73061 + {Rational-73065} + (\(ds-73231 : Rational-73065) + (ds-73232 : Rational-73065) -> + Rational_match-73067 + ds-73231 + {Bool-73046} + (\(n-73233 : integer) (d-73234 : integer) -> + Rational_match-73067 + ds-73232 + {Bool-73046} + (\(n'-73235 : integer) (d'-73236 : integer) -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (equalsInteger n-73233 n'-73235) + True-73047 + False-73048) + {all dead-73237. Bool-73046} + (/\dead-73238 -> + ifThenElse + {Bool-73046} + (equalsInteger d-73234 d'-73236) + True-73047 + False-73048) + (/\dead-73239 -> False-73048) + {all dead-73240. dead-73240}))) + (\(ds-73241 : Rational-73065) + (ds-73242 : Rational-73065) -> + Rational_match-73067 + ds-73241 + {Ordering-73055} + (\(n-73243 : integer) (d-73244 : integer) -> + Rational_match-73067 + ds-73242 + {Ordering-73055} + (\(n'-73245 : integer) (d'-73246 : integer) -> + `$fOrdInteger_$ccompare`-73115 + (multiplyInteger n-73243 d'-73246) + (multiplyInteger n'-73245 d-73244)))) + (\(ds-73247 : Rational-73065) + (ds-73248 : Rational-73065) -> + Rational_match-73067 + ds-73247 + {Bool-73046} + (\(n-73249 : integer) (d-73250 : integer) -> + Rational_match-73067 + ds-73248 + {Bool-73046} + (\(n'-73251 : integer) (d'-73252 : integer) -> + ifThenElse + {Bool-73046} + (lessThanInteger + (multiplyInteger n-73249 d'-73252) + (multiplyInteger n'-73251 d-73250)) + True-73047 + False-73048))) + `$fOrdRational0_$c<=`-73104 + (\(ds-73253 : Rational-73065) + (ds-73254 : Rational-73065) -> + Rational_match-73067 + ds-73253 + {Bool-73046} + (\(n-73255 : integer) (d-73256 : integer) -> + Rational_match-73067 + ds-73254 + {Bool-73046} + (\(n'-73257 : integer) (d'-73258 : integer) -> + ifThenElse + {Bool-73046} + (lessThanEqualsInteger + (multiplyInteger n-73255 d'-73258) + (multiplyInteger n'-73257 d-73256)) + False-73048 + True-73047))) + (\(ds-73259 : Rational-73065) + (ds-73260 : Rational-73065) -> + Rational_match-73067 + ds-73259 + {Bool-73046} + (\(n-73261 : integer) (d-73262 : integer) -> + Rational_match-73067 + ds-73260 + {Bool-73046} + (\(n'-73263 : integer) (d'-73264 : integer) -> + ifThenElse + {Bool-73046} + (lessThanInteger + (multiplyInteger n-73261 d'-73264) + (multiplyInteger n'-73263 d-73262)) + False-73048 + True-73047))) + (\(x-73265 : Rational-73065) (y-73266 : Rational-73065) -> + Bool_match-73049 + (`$fOrdRational0_$c<=`-73104 x-73265 y-73266) + {all dead-73267. Rational-73065} + (/\dead-73268 -> y-73266) + (/\dead-73269 -> x-73265) + {all dead-73270. dead-73270}) + (\(x-73271 : Rational-73065) (y-73272 : Rational-73065) -> + Bool_match-73049 + (`$fOrdRational0_$c<=`-73104 x-73271 y-73272) + {all dead-73273. Rational-73065} + (/\dead-73274 -> x-73271) + (/\dead-73275 -> y-73272) + {all dead-73276. dead-73276})) + preds-73228 + (ifThenElse + {Unit-73076 -> Rational-73065} + (nullList {data} (tailList {data} bl'-73278)) + (\(ds-73279 : Unit-73076) -> + unsafeRatio-73086 + (unIData (headList {data} bl-73277)) + (unIData (headList {data} bl'-73278))) + (\(ds-73280 : Unit-73076) -> error {Rational-73065}) + Unit-73077)) + {all dead-73281. dead-73281} + !validateParamValues-73119 : + List-73026 ParamValue-73068 -> list data -> Bool-73046 + = \(ds-73120 : List-73026 ParamValue-73068) -> + List_match-73029 + {ParamValue-73068} + ds-73120 + {list data -> Bool-73046} + (\(eta-73121 : list data) -> + ifThenElse + {Bool-73046} + (nullList {data} eta-73121) + True-73047 + False-73048) + (\(paramValueHd-73122 : ParamValue-73068) + (paramValueTl-73123 : List-73026 ParamValue-73068) + (actualValueData-73124 : list data) -> + Bool_match-73049 + (validateParamValue-73116 + paramValueHd-73122 + (headList {data} actualValueData-73124)) + {all dead-73125. Bool-73046} + (/\dead-73126 -> + validateParamValues-73119 + paramValueTl-73123 + (tailList {data} actualValueData-73124)) + (/\dead-73127 -> False-73048) + {all dead-73128. dead-73128}) + in + letrec + !runRules-73282 : + List-73026 (Tuple2-73031 integer ParamValue-73068) -> + List-73026 (Tuple2-73031 data data) -> + Bool-73046 + = \(ds-73283 : List-73026 (Tuple2-73031 integer ParamValue-73068)) + (cparams-73284 : List-73026 (Tuple2-73031 data data)) -> + let + !fail-73294 : unit -> Bool-73046 + = \(ds-73285 : unit) -> + (let + a-73286 = Tuple2-73031 data data + in + \(ds-73287 : List-73026 a-73286) -> + List_match-73029 + {a-73286} + ds-73287 + {all dead-73288. Bool-73046} + (/\dead-73289 -> True-73047) + (\(ipv-73290 : a-73286) + (ipv-73291 : List-73026 a-73286) -> + /\dead-73292 -> False-73048) + {all dead-73293. dead-73293}) + cparams-73284 + in + List_match-73029 + {Tuple2-73031 integer ParamValue-73068} + ds-73283 + {all dead-73295. Bool-73046} + (/\dead-73296 -> fail-73294 ()) + (\(ds-73297 : Tuple2-73031 integer ParamValue-73068) + (cfgRest-73298 : + List-73026 (Tuple2-73031 integer ParamValue-73068)) -> + /\dead-73299 -> + Tuple2_match-73033 + {integer} + {ParamValue-73068} + ds-73297 + {Bool-73046} + (\(expectedPid-73300 : integer) + (paramValue-73301 : ParamValue-73068) -> + List_match-73029 + {Tuple2-73031 data data} + cparams-73284 + {all dead-73302. Bool-73046} + (/\dead-73303 -> fail-73294 ()) + (\(ds-73304 : Tuple2-73031 data data) + (cparamsRest-73305 : + List-73026 (Tuple2-73031 data data)) -> + /\dead-73306 -> + Tuple2_match-73033 + {data} + {data} + ds-73304 + {Bool-73046} + (\(ds-73307 : data) + (actualValueData-73308 : data) -> + Ordering_match-73059 + (`$fOrdInteger_$ccompare`-73115 + (unIData ds-73307) + expectedPid-73300) + {all dead-73309. Bool-73046} + (/\dead-73310 -> + Bool_match-73049 + (validateParamValue-73116 + paramValue-73301 + actualValueData-73308) + {all dead-73311. Bool-73046} + (/\dead-73312 -> + runRules-73282 + cfgRest-73298 + cparamsRest-73305) + (/\dead-73313 -> False-73048) + {all dead-73314. dead-73314}) + (/\dead-73315 -> + runRules-73282 + cfgRest-73298 + cparams-73284) + (/\dead-73316 -> False-73048) + {all dead-73317. dead-73317})) + {all dead-73318. dead-73318})) + {all dead-73319. dead-73319} + in + let + data (Maybe-73041 :: * -> *) a-73045 | Maybe_match-73044 where + Just-73042 : a-73045 -> Maybe-73041 a-73045 + Nothing-73043 : Maybe-73041 a-73045 + in + letrec + !go-73036 : list (pair data data) -> List-73026 (Tuple2-73031 data data) + = \(l-73037 : list (pair data data)) -> + chooseList + {pair data data} + {unit -> List-73026 (Tuple2-73031 data data)} + l-73037 + (\(ds-73038 : unit) -> Nil-73027 {Tuple2-73031 data data}) + (\(ds-73039 : unit) -> + Cons-73028 + {Tuple2-73031 data data} + (let + !p-73040 : pair data data = headList {pair data data} l-73037 + in + Tuple2-73032 + {data} + {data} + (fstPair {data} {data} p-73040) + (sndPair {data} {data} p-73040)) + (go-73036 (tailList {pair data data} l-73037))) + () + in + let + !fun-74173 : List-73026 (Tuple2-73031 data data) -> Bool-73046 + = runRules-73282 + ((let + a-73320 = Tuple2-73031 integer ParamValue-73068 in - go ds - !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering - = \(eta : integer) (eta : integer) -> - Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) - {all dead. Ordering} - (/\dead -> EQ) - (/\dead -> - Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) - {all dead. Ordering} - (/\dead -> LT) - (/\dead -> GT) - {all dead. dead}) - {all dead. dead} - data Rational | Rational_match where - Rational : integer -> integer -> Rational - !`$fOrdRational0_$c<=` : Rational -> Rational -> Bool - = \(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - True - False)) - in - letrec - !euclid : integer -> integer -> integer - = \(x : integer) (y : integer) -> - Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) - {all dead. integer} - (/\dead -> x) - (/\dead -> euclid y (modInteger x y)) - {all dead. dead} - in - letrec - !unsafeRatio : integer -> integer -> Rational - = \(n : integer) (d : integer) -> - Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) - {all dead. Rational} - (/\dead -> error {Rational}) - (/\dead -> - Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) - {all dead. Rational} - (/\dead -> - unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) - (/\dead -> - let - !gcd' : integer = euclid n d - in - Rational (quotientInteger n gcd') (quotientInteger d gcd')) - {all dead. dead}) - {all dead. dead} - in - letrec - data ParamValue | ParamValue_match where - ParamAny : ParamValue - ParamInteger : - (\v -> List (Tuple2 PredKey (List v))) integer -> ParamValue - ParamList : List ParamValue -> ParamValue - ParamRational : - (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue - in - let - data Unit | Unit_match where - Unit : Unit - in - letrec - !validateParamValue : ParamValue -> data -> Bool - = \(eta : ParamValue) (eta : data) -> - let - ~bl : list data = unListData eta - ~bl' : list data = tailList {data} bl - in - ParamValue_match - eta - {all dead. Bool} - (/\dead -> True) - (\(preds : (\v -> List (Tuple2 PredKey (List v))) integer) -> - /\dead -> - validatePreds - {integer} - (CConsOrd + \(g-73321 : + all b-73322. + (a-73320 -> b-73322 -> b-73322) -> b-73322 -> b-73322) -> + g-73321 + {List-73026 a-73320} + (\(ds-73323 : a-73320) (ds-73324 : List-73026 a-73320) -> + Cons-73028 {a-73320} ds-73323 ds-73324) + (Nil-73027 {a-73320})) + (/\a-73325 -> + \(c-73326 : + Tuple2-73031 integer ParamValue-73068 -> a-73325 -> a-73325) + (n-73327 : a-73325) -> + c-73326 + (Tuple2-73032 {integer} - (\(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False) - `$fOrdInteger_$ccompare` - (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) - (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) - (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - False - True) - (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) False True) - (\(x : integer) (y : integer) -> - Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) - {all dead. integer} - (/\dead -> y) - (/\dead -> x) - {all dead. dead}) - (\(x : integer) (y : integer) -> - Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) - {all dead. integer} - (/\dead -> x) - (/\dead -> y) - {all dead. dead})) - preds - (unIData eta)) - (\(paramValues : List ParamValue) -> - /\dead -> validateParamValues paramValues (unListData eta)) - (\(preds : (\v -> List (Tuple2 PredKey (List v))) Rational) -> - /\dead -> - validatePreds - {Rational} - (CConsOrd - {Rational} - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger n n') - True - False) - {all dead. Bool} - (/\dead -> - ifThenElse - {Bool} - (equalsInteger d d') - True - False) - (/\dead -> False) - {all dead. dead}))) - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Ordering} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Ordering} - (\(n' : integer) (d' : integer) -> - `$fOrdInteger_$ccompare` - (multiplyInteger n d') - (multiplyInteger n' d)))) - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - True - False))) - `$fOrdRational0_$c<=` - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - False - True))) - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - False - True))) - (\(x : Rational) (y : Rational) -> - Bool_match - (`$fOrdRational0_$c<=` x y) - {all dead. Rational} - (/\dead -> y) - (/\dead -> x) - {all dead. dead}) - (\(x : Rational) (y : Rational) -> - Bool_match - (`$fOrdRational0_$c<=` x y) - {all dead. Rational} - (/\dead -> x) - (/\dead -> y) - {all dead. dead})) - preds - (ifThenElse - {Unit -> Rational} - (nullList {data} (tailList {data} bl')) - (\(ds : Unit) -> - unsafeRatio - (unIData (headList {data} bl)) - (unIData (headList {data} bl'))) - (\(ds : Unit) -> error {Rational}) - Unit)) - {all dead. dead} - !validateParamValues : List ParamValue -> list data -> Bool - = \(ds : List ParamValue) -> - List_match - {ParamValue} - ds - {list data -> Bool} - (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) - (\(paramValueHd : ParamValue) - (paramValueTl : List ParamValue) - (actualValueData : list data) -> - Bool_match - (validateParamValue - paramValueHd - (headList {data} actualValueData)) - {all dead. Bool} - (/\dead -> - validateParamValues - paramValueTl - (tailList {data} actualValueData)) - (/\dead -> False) - {all dead. dead}) - in - letrec - !runRules : - List (Tuple2 integer ParamValue) -> List (Tuple2 data data) -> Bool - = \(ds : List (Tuple2 integer ParamValue)) - (cparams : List (Tuple2 data data)) -> - let - !fail : unit -> Bool - = \(ds : unit) -> - (let - a = Tuple2 data data - in - \(ds : List a) -> - List_match - {a} - ds - {all dead. Bool} - (/\dead -> True) - (\(ipv : a) (ipv : List a) -> /\dead -> False) - {all dead. dead}) - cparams - in - List_match - {Tuple2 integer ParamValue} - ds - {all dead. Bool} - (/\dead -> fail ()) - (\(ds : Tuple2 integer ParamValue) - (cfgRest : List (Tuple2 integer ParamValue)) -> - /\dead -> - Tuple2_match - {integer} - {ParamValue} - ds - {Bool} - (\(expectedPid : integer) (paramValue : ParamValue) -> - List_match - {Tuple2 data data} - cparams - {all dead. Bool} - (/\dead -> fail ()) - (\(ds : Tuple2 data data) - (cparamsRest : List (Tuple2 data data)) -> - /\dead -> - Tuple2_match - {data} - {data} - ds - {Bool} - (\(ds : data) (actualValueData : data) -> - Ordering_match - (`$fOrdInteger_$ccompare` - (unIData ds) - expectedPid) - {all dead. Bool} - (/\dead -> - Bool_match - (validateParamValue - paramValue - actualValueData) - {all dead. Bool} - (/\dead -> - runRules cfgRest cparamsRest) - (/\dead -> False) - {all dead. dead}) - (/\dead -> runRules cfgRest cparams) - (/\dead -> False) - {all dead. dead})) - {all dead. dead})) - {all dead. dead} - in - let - data (Maybe :: * -> *) a | Maybe_match where - Just : a -> Maybe a - Nothing : Maybe a - in - letrec - !go : list (pair data data) -> List (Tuple2 data data) - = \(l : list (pair data data)) -> - chooseList - {pair data data} - {unit -> List (Tuple2 data data)} - l - (\(ds : unit) -> Nil {Tuple2 data data}) - (\(ds : unit) -> - Cons - {Tuple2 data data} - (let - !p : pair data data = headList {pair data data} l - in - Tuple2 - {data} - {data} - (fstPair {data} {data} p) - (sndPair {data} {data} p)) - (go (tailList {pair data data} l))) - () - in - let - !fun : List (Tuple2 data data) -> Bool - = runRules - ((let - a = Tuple2 integer ParamValue - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : Tuple2 integer ParamValue -> a -> a) (n : a) -> - c - (Tuple2 - {integer} - {ParamValue} - 0 - (ParamInteger - ((let - a = Tuple2 PredKey (List integer) - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : Tuple2 PredKey (List integer) -> a -> a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) (n : a) -> - c 30 (c 0 n)) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 1000 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 1 - (ParamInteger - ((let - a = Tuple2 PredKey (List integer) - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 PredKey (List integer) -> a -> a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 100000 (c 0 n)) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 10000000 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 2 - (ParamInteger - ((let - a = Tuple2 PredKey (List integer) - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 PredKey (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 24576 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 122880 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 3 - (ParamInteger - ((let - a = Tuple2 PredKey (List integer) - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 PredKey (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 0 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 32768 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 4 - (ParamInteger + {ParamValue-73068} + 0 + (ParamInteger-73070 + ((let + a-73328 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) + in + \(g-73329 : + all b-73330. + (a-73328 -> b-73330 -> b-73330) -> + b-73330 -> + b-73330) -> + g-73329 + {List-73026 a-73328} + (\(ds-73331 : a-73328) + (ds-73332 : List-73026 a-73328) -> + Cons-73028 {a-73328} ds-73331 ds-73332) + (Nil-73027 {a-73328})) + (/\a-73333 -> + \(c-73334 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> + a-73333 -> + a-73333) + (n-73335 : a-73333) -> + c-73334 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MinValue-73052 ((let - a = Tuple2 PredKey (List integer) + a-73336 = List-73026 integer in - \(g : - all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 0 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : - integer -> a -> a) - (n : a) -> - c 5000 n) - (\(ds : integer) - (ds : - List integer) -> - Cons - {integer} - ds - ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 5 - (ParamInteger + \(c-73337 : + integer -> a-73336 -> a-73336) + (n-73338 : a-73336) -> + c-73337 30 (c-73337 0 n-73338)) + (\(ds-73339 : integer) + (ds-73340 : List-73026 integer) -> + Cons-73028 + {integer} + ds-73339 + ds-73340) + (Nil-73027 {integer}))) + (c-73334 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MaxValue-73051 + ((let + a-73341 = List-73026 integer + in + \(c-73342 : + integer -> a-73341 -> a-73341) + (n-73343 : a-73341) -> + c-73342 1000 n-73343) + (\(ds-73344 : integer) + (ds-73345 : + List-73026 integer) -> + Cons-73028 + {integer} + ds-73344 + ds-73345) + (Nil-73027 {integer}))) + n-73335))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 1 + (ParamInteger-73070 + ((let + a-73346 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) + in + \(g-73347 : + all b-73348. + (a-73346 -> b-73348 -> b-73348) -> + b-73348 -> + b-73348) -> + g-73347 + {List-73026 a-73346} + (\(ds-73349 : a-73346) + (ds-73350 : List-73026 a-73346) -> + Cons-73028 {a-73346} ds-73349 ds-73350) + (Nil-73027 {a-73346})) + (/\a-73351 -> + \(c-73352 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> + a-73351 -> + a-73351) + (n-73353 : a-73351) -> + c-73352 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MinValue-73052 ((let - a = Tuple2 PredKey (List integer) + a-73354 = List-73026 integer in - \(g : - all b. - (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : - integer -> a -> a) - (n : a) -> - c 1000000 (c 0 n)) - (\(ds : integer) - (ds : - List integer) -> - Cons - {integer} - ds - ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c 5000000 n) - (\(ds : integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 6 - (ParamInteger + \(c-73355 : + integer -> a-73354 -> a-73354) + (n-73356 : a-73354) -> + c-73355 + 100000 + (c-73355 0 n-73356)) + (\(ds-73357 : integer) + (ds-73358 : + List-73026 integer) -> + Cons-73028 + {integer} + ds-73357 + ds-73358) + (Nil-73027 {integer}))) + (c-73352 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List integer) + a-73359 = List-73026 integer in - \(g : - all b. - (a -> b -> b) -> - b -> - b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c - 250000000 - (c 0 n)) - (\(ds : integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c 500000000 n) - (\(ds : integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 7 - (ParamInteger + \(c-73360 : + integer -> + a-73359 -> + a-73359) + (n-73361 : a-73359) -> + c-73360 10000000 n-73361) + (\(ds-73362 : integer) + (ds-73363 : + List-73026 integer) -> + Cons-73028 + {integer} + ds-73362 + ds-73363) + (Nil-73027 {integer}))) + n-73353))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 2 + (ParamInteger-73070 + ((let + a-73364 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) + in + \(g-73365 : + all b-73366. + (a-73364 -> b-73366 -> b-73366) -> + b-73366 -> + b-73366) -> + g-73365 + {List-73026 a-73364} + (\(ds-73367 : a-73364) + (ds-73368 : List-73026 a-73364) -> + Cons-73028 + {a-73364} + ds-73367 + ds-73368) + (Nil-73027 {a-73364})) + (/\a-73369 -> + \(c-73370 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> + a-73369 -> + a-73369) + (n-73371 : a-73369) -> + c-73370 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MinValue-73052 + ((let + a-73372 = List-73026 integer + in + \(c-73373 : + integer -> + a-73372 -> + a-73372) + (n-73374 : a-73372) -> + c-73373 24576 n-73374) + (\(ds-73375 : integer) + (ds-73376 : + List-73026 integer) -> + Cons-73028 + {integer} + ds-73375 + ds-73376) + (Nil-73027 {integer}))) + (c-73370 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MaxValue-73051 + ((let + a-73377 + = List-73026 integer + in + \(c-73378 : + integer -> + a-73377 -> + a-73377) + (n-73379 : a-73377) -> + c-73378 122880 n-73379) + (\(ds-73380 : integer) + (ds-73381 : + List-73026 integer) -> + Cons-73028 + {integer} + ds-73380 + ds-73381) + (Nil-73027 {integer}))) + n-73371))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 3 + (ParamInteger-73070 + ((let + a-73382 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) + in + \(g-73383 : + all b-73384. + (a-73382 -> b-73384 -> b-73384) -> + b-73384 -> + b-73384) -> + g-73383 + {List-73026 a-73382} + (\(ds-73385 : a-73382) + (ds-73386 : List-73026 a-73382) -> + Cons-73028 + {a-73382} + ds-73385 + ds-73386) + (Nil-73027 {a-73382})) + (/\a-73387 -> + \(c-73388 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> + a-73387 -> + a-73387) + (n-73389 : a-73387) -> + c-73388 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MinValue-73052 ((let - a - = Tuple2 - PredKey - (List integer) + a-73390 + = List-73026 integer in - \(g : - all b. - (a -> b -> b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c 0 n) - (\(ds : integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - (c - (Tuple2 - {integer} - {ParamValue} - 8 - (ParamInteger + \(c-73391 : + integer -> + a-73390 -> + a-73390) + (n-73392 : a-73390) -> + c-73391 0 n-73392) + (\(ds-73393 : integer) + (ds-73394 : + List-73026 integer) -> + Cons-73028 + {integer} + ds-73393 + ds-73394) + (Nil-73027 {integer}))) + (c-73388 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List integer) + a-73395 + = List-73026 integer in - \(g : - all b. - (a -> b -> b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c - 250 - (c 0 n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 2000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - NotEqual - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))))) - (c - (Tuple2 - {integer} - {ParamValue} - 9 - (ParamRational + \(c-73396 : + integer -> + a-73395 -> + a-73395) + (n-73397 : a-73395) -> + c-73396 32768 n-73397) + (\(ds-73398 : integer) + (ds-73399 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73398 + ds-73399) + (Nil-73027 {integer}))) + n-73389))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 4 + (ParamInteger-73070 + ((let + a-73400 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) + in + \(g-73401 : + all b-73402. + (a-73400 -> + b-73402 -> + b-73402) -> + b-73402 -> + b-73402) -> + g-73401 + {List-73026 a-73400} + (\(ds-73403 : a-73400) + (ds-73404 : + List-73026 a-73400) -> + Cons-73028 + {a-73400} + ds-73403 + ds-73404) + (Nil-73027 {a-73400})) + (/\a-73405 -> + \(c-73406 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> + a-73405 -> + a-73405) + (n-73407 : a-73405) -> + c-73406 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MinValue-73052 + ((let + a-73408 + = List-73026 integer + in + \(c-73409 : + integer -> + a-73408 -> + a-73408) + (n-73410 : a-73408) -> + c-73409 0 n-73410) + (\(ds-73411 : integer) + (ds-73412 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73411 + ds-73412) + (Nil-73027 {integer}))) + (c-73406 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List Rational) + a-73413 + = List-73026 + integer in - \(g : - all b. - (a -> b -> b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 10) - (c - (unsafeRatio - 0 - 1) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 10 - (ParamRational + \(c-73414 : + integer -> + a-73413 -> + a-73413) + (n-73415 : a-73413) -> + c-73414 5000 n-73415) + (\(ds-73416 : integer) + (ds-73417 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73416 + ds-73417) + (Nil-73027 {integer}))) + n-73407))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 5 + (ParamInteger-73070 + ((let + a-73418 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) + in + \(g-73419 : + all b-73420. + (a-73418 -> + b-73420 -> + b-73420) -> + b-73420 -> + b-73420) -> + g-73419 + {List-73026 a-73418} + (\(ds-73421 : a-73418) + (ds-73422 : + List-73026 a-73418) -> + Cons-73028 + {a-73418} + ds-73421 + ds-73422) + (Nil-73027 {a-73418})) + (/\a-73423 -> + \(c-73424 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> + a-73423 -> + a-73423) + (n-73425 : a-73423) -> + c-73424 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MinValue-73052 + ((let + a-73426 + = List-73026 + integer + in + \(c-73427 : + integer -> + a-73426 -> + a-73426) + (n-73428 : a-73426) -> + c-73427 + 1000000 + (c-73427 + 0 + n-73428)) + (\(ds-73429 : integer) + (ds-73430 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73429 + ds-73430) + (Nil-73027 {integer}))) + (c-73424 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MaxValue-73051 + ((let + a-73431 + = List-73026 + integer + in + \(c-73432 : + integer -> + a-73431 -> + a-73431) + (n-73433 : + a-73431) -> + c-73432 + 5000000 + n-73433) + (\(ds-73434 : + integer) + (ds-73435 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73434 + ds-73435) + (Nil-73027 + {integer}))) + n-73425))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 6 + (ParamInteger-73070 + ((let + a-73436 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) + in + \(g-73437 : + all b-73438. + (a-73436 -> + b-73438 -> + b-73438) -> + b-73438 -> + b-73438) -> + g-73437 + {List-73026 a-73436} + (\(ds-73439 : a-73436) + (ds-73440 : + List-73026 a-73436) -> + Cons-73028 + {a-73436} + ds-73439 + ds-73440) + (Nil-73027 {a-73436})) + (/\a-73441 -> + \(c-73442 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> + a-73441 -> + a-73441) + (n-73443 : a-73441) -> + c-73442 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MinValue-73052 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73444 + = List-73026 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : - List a) -> - Cons - {a} - ds - ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1000) - (c - (unsafeRatio - 0 - 1) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 200) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 11 - (ParamRational + \(c-73445 : + integer -> + a-73444 -> + a-73444) + (n-73446 : + a-73444) -> + c-73445 + 250000000 + (c-73445 + 0 + n-73446)) + (\(ds-73447 : + integer) + (ds-73448 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73447 + ds-73448) + (Nil-73027 + {integer}))) + (c-73442 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73449 + = List-73026 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 10) - (c - (unsafeRatio - 0 - 1) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 3 - 10) - (c - (unsafeRatio - 1 - 1) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 16 - (ParamInteger + \(c-73450 : + integer -> + a-73449 -> + a-73449) + (n-73451 : + a-73449) -> + c-73450 + 500000000 + n-73451) + (\(ds-73452 : + integer) + (ds-73453 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73452 + ds-73453) + (Nil-73027 + {integer}))) + n-73443))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 7 + (ParamInteger-73070 + ((let + a-73454 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) + in + \(g-73455 : + all b-73456. + (a-73454 -> + b-73456 -> + b-73456) -> + b-73456 -> + b-73456) -> + g-73455 + {List-73026 a-73454} + (\(ds-73457 : a-73454) + (ds-73458 : + List-73026 + a-73454) -> + Cons-73028 + {a-73454} + ds-73457 + ds-73458) + (Nil-73027 {a-73454})) + (/\a-73459 -> + \(c-73460 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73459 -> + a-73459) + (n-73461 : a-73459) -> + c-73460 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} + MinValue-73052 + ((let + a-73462 + = List-73026 + integer + in + \(c-73463 : + integer -> + a-73462 -> + a-73462) + (n-73464 : + a-73462) -> + c-73463 + 0 + n-73464) + (\(ds-73465 : + integer) + (ds-73466 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73465 + ds-73466) + (Nil-73027 + {integer}))) + n-73461)))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 8 + (ParamInteger-73070 + ((let + a-73467 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-73468 : + all b-73469. + (a-73467 -> + b-73469 -> + b-73469) -> + b-73469 -> + b-73469) -> + g-73468 + {List-73026 a-73467} + (\(ds-73470 : a-73467) + (ds-73471 : + List-73026 + a-73467) -> + Cons-73028 + {a-73467} + ds-73470 + ds-73471) + (Nil-73027 {a-73467})) + (/\a-73472 -> + \(c-73473 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73472 -> + a-73472) + (n-73474 : a-73472) -> + c-73473 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 ((let - a - = Tuple2 - PredKey - (List - integer) + a-73475 + = List-73026 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 500000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 17 - (ParamInteger + \(c-73476 : + integer -> + a-73475 -> + a-73475) + (n-73477 : + a-73475) -> + c-73476 + 250 + (c-73476 + 0 + n-73477)) + (\(ds-73478 : + integer) + (ds-73479 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73478 + ds-73479) + (Nil-73027 + {integer}))) + (c-73473 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List - integer) + a-73480 + = List-73026 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 3000 - (c - 0 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 6500 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - NotEqual - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))))) - (c - (Tuple2 - {integer} - {ParamValue} - 18 - ParamAny) - (c - (Tuple2 - {integer} - {ParamValue} - 19 - (ParamList + \(c-73481 : + integer -> + a-73480 -> + a-73480) + (n-73482 : + a-73480) -> + c-73481 + 2000 + n-73482) + (\(ds-73483 : + integer) + (ds-73484 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73483 + ds-73484) + (Nil-73027 + {integer}))) + (c-73473 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + NotEqual-73053 + ((let + a-73485 + = List-73026 + integer + in + \(c-73486 : + integer -> + a-73485 -> + a-73485) + (n-73487 : + a-73485) -> + c-73486 + 0 + n-73487) + (\(ds-73488 : + integer) + (ds-73489 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73488 + ds-73489) + (Nil-73027 + {integer}))) + n-73474)))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 9 + (ParamRational-73072 + ((let + a-73490 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73491 : + all b-73492. + (a-73490 -> + b-73492 -> + b-73492) -> + b-73492 -> + b-73492) -> + g-73491 + {List-73026 a-73490} + (\(ds-73493 : + a-73490) + (ds-73494 : + List-73026 + a-73490) -> + Cons-73028 + {a-73490} + ds-73493 + ds-73494) + (Nil-73027 + {a-73490})) + (/\a-73495 -> + \(c-73496 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73495 -> + a-73495) + (n-73497 : + a-73495) -> + c-73496 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-73498 + = List-73026 + Rational-73065 + in + \(c-73499 : + Rational-73065 -> + a-73498 -> + a-73498) + (n-73500 : + a-73498) -> + c-73499 + (unsafeRatio-73086 + 1 + 10) + (c-73499 + (unsafeRatio-73086 + 0 + 1) + n-73500)) + (\(ds-73501 : + Rational-73065) + (ds-73502 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73501 + ds-73502) + (Nil-73027 + {Rational-73065}))) + (c-73496 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-73503 + = List-73026 + Rational-73065 + in + \(c-73504 : + Rational-73065 -> + a-73503 -> + a-73503) + (n-73505 : + a-73503) -> + c-73504 + (unsafeRatio-73086 + 1 + 1) + n-73505) + (\(ds-73506 : + Rational-73065) + (ds-73507 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73506 + ds-73507) + (Nil-73027 + {Rational-73065}))) + n-73497))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 10 + (ParamRational-73072 + ((let + a-73508 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73509 : + all b-73510. + (a-73508 -> + b-73510 -> + b-73510) -> + b-73510 -> + b-73510) -> + g-73509 + {List-73026 + a-73508} + (\(ds-73511 : + a-73508) + (ds-73512 : + List-73026 + a-73508) -> + Cons-73028 + {a-73508} + ds-73511 + ds-73512) + (Nil-73027 + {a-73508})) + (/\a-73513 -> + \(c-73514 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73513 -> + a-73513) + (n-73515 : + a-73513) -> + c-73514 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-73516 + = List-73026 + Rational-73065 + in + \(c-73517 : + Rational-73065 -> + a-73516 -> + a-73516) + (n-73518 : + a-73516) -> + c-73517 + (unsafeRatio-73086 + 1 + 1000) + (c-73517 + (unsafeRatio-73086 + 0 + 1) + n-73518)) + (\(ds-73519 : + Rational-73065) + (ds-73520 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73519 + ds-73520) + (Nil-73027 + {Rational-73065}))) + (c-73514 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = List - ParamValue + a-73521 + = List-73026 + Rational-73065 in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 25) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 5) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 20000) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 5000) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - n)) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 20 - (ParamList + \(c-73522 : + Rational-73065 -> + a-73521 -> + a-73521) + (n-73523 : + a-73521) -> + c-73522 + (unsafeRatio-73086 + 1 + 200) + n-73523) + (\(ds-73524 : + Rational-73065) + (ds-73525 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73524 + ds-73525) + (Nil-73027 + {Rational-73065}))) + n-73515))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 11 + (ParamRational-73072 + ((let + a-73526 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73527 : + all b-73528. + (a-73526 -> + b-73528 -> + b-73528) -> + b-73528 -> + b-73528) -> + g-73527 + {List-73026 + a-73526} + (\(ds-73529 : + a-73526) + (ds-73530 : + List-73026 + a-73526) -> + Cons-73028 + {a-73526} + ds-73529 + ds-73530) + (Nil-73027 + {a-73526})) + (/\a-73531 -> + \(c-73532 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73531 -> + a-73531) + (n-73533 : + a-73531) -> + c-73532 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-73534 + = List-73026 + Rational-73065 + in + \(c-73535 : + Rational-73065 -> + a-73534 -> + a-73534) + (n-73536 : + a-73534) -> + c-73535 + (unsafeRatio-73086 + 1 + 10) + (c-73535 + (unsafeRatio-73086 + 0 + 1) + n-73536)) + (\(ds-73537 : + Rational-73065) + (ds-73538 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73537 + ds-73538) + (Nil-73027 + {Rational-73065}))) + (c-73532 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = List - ParamValue + a-73539 + = List-73026 + Rational-73065 in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 40000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - (c - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 15000000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - n)) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 21 - (ParamList + \(c-73540 : + Rational-73065 -> + a-73539 -> + a-73539) + (n-73541 : + a-73539) -> + c-73540 + (unsafeRatio-73086 + 3 + 10) + (c-73540 + (unsafeRatio-73086 + 1 + 1) + n-73541)) + (\(ds-73542 : + Rational-73065) + (ds-73543 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73542 + ds-73543) + (Nil-73027 + {Rational-73065}))) + n-73533))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 16 + (ParamInteger-73070 + ((let + a-73544 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-73545 : + all b-73546. + (a-73544 -> + b-73546 -> + b-73546) -> + b-73546 -> + b-73546) -> + g-73545 + {List-73026 + a-73544} + (\(ds-73547 : + a-73544) + (ds-73548 : + List-73026 + a-73544) -> + Cons-73028 + {a-73544} + ds-73547 + ds-73548) + (Nil-73027 + {a-73544})) + (/\a-73549 -> + \(c-73550 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73549 -> + a-73549) + (n-73551 : + a-73549) -> + c-73550 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-73552 + = List-73026 + integer + in + \(c-73553 : + integer -> + a-73552 -> + a-73552) + (n-73554 : + a-73552) -> + c-73553 + 0 + n-73554) + (\(ds-73555 : + integer) + (ds-73556 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73555 + ds-73556) + (Nil-73027 + {integer}))) + (c-73550 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 ((let - a - = List - ParamValue + a-73557 + = List-73026 + integer in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 120000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - (c - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 40000000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - n)) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 22 - (ParamInteger + \(c-73558 : + integer -> + a-73557 -> + a-73557) + (n-73559 : + a-73557) -> + c-73558 + 500000000 + n-73559) + (\(ds-73560 : + integer) + (ds-73561 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73560 + ds-73561) + (Nil-73027 + {integer}))) + n-73551))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 17 + (ParamInteger-73070 + ((let + a-73562 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-73563 : + all b-73564. + (a-73562 -> + b-73564 -> + b-73564) -> + b-73564 -> + b-73564) -> + g-73563 + {List-73026 + a-73562} + (\(ds-73565 : + a-73562) + (ds-73566 : + List-73026 + a-73562) -> + Cons-73028 + {a-73562} + ds-73565 + ds-73566) + (Nil-73027 + {a-73562})) + (/\a-73567 -> + \(c-73568 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73567 -> + a-73567) + (n-73569 : + a-73567) -> + c-73568 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-73570 + = List-73026 + integer + in + \(c-73571 : + integer -> + a-73570 -> + a-73570) + (n-73572 : + a-73570) -> + c-73571 + 3000 + (c-73571 + 0 + n-73572)) + (\(ds-73573 : + integer) + (ds-73574 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73573 + ds-73574) + (Nil-73027 + {integer}))) + (c-73568 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List - integer) + a-73575 + = List-73026 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(c-73576 : + integer -> + a-73575 -> + a-73575) + (n-73577 : + a-73575) -> + c-73576 + 6500 + n-73577) + (\(ds-73578 : + integer) + (ds-73579 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73578 + ds-73579) + (Nil-73027 + {integer}))) + (c-73568 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + NotEqual-73053 + ((let + a-73580 + = List-73026 + integer + in + \(c-73581 : + integer -> + a-73580 -> + a-73580) + (n-73582 : + a-73580) -> + c-73581 + 0 + n-73582) + (\(ds-73583 : + integer) + (ds-73584 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73583 + ds-73584) + (Nil-73027 + {integer}))) + n-73569)))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 18 + ParamAny-73069) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 19 + (ParamList-73071 + ((let + a-73585 + = List-73026 + ParamValue-73068 + in + \(c-73586 : + ParamValue-73068 -> + a-73585 -> + a-73585) + (n-73587 : + a-73585) -> + c-73586 + (ParamRational-73072 + ((let + a-73588 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73589 : + all b-73590. + (a-73588 -> + b-73590 -> + b-73590) -> + b-73590 -> + b-73590) -> + g-73589 + {List-73026 + a-73588} + (\(ds-73591 : + a-73588) + (ds-73592 : + List-73026 + a-73588) -> + Cons-73028 + {a-73588} + ds-73591 + ds-73592) + (Nil-73027 + {a-73588})) + (/\a-73593 -> + \(c-73594 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73593 -> + a-73593) + (n-73595 : + a-73593) -> + c-73594 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = List - integer + a-73596 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-73597 : + Rational-73065 -> + a-73596 -> + a-73596) + (n-73598 : + a-73596) -> + c-73597 + (unsafeRatio-73086 + 1 + 25) + n-73598) + (\(ds-73599 : + Rational-73065) + (ds-73600 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73599 + ds-73600) + (Nil-73027 + {Rational-73065}))) + (c-73594 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = List - integer + a-73601 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 12288 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 23 - (ParamInteger + \(c-73602 : + Rational-73065 -> + a-73601 -> + a-73601) + (n-73603 : + a-73601) -> + c-73602 + (unsafeRatio-73086 + 1 + 5) + n-73603) + (\(ds-73604 : + Rational-73065) + (ds-73605 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73604 + ds-73605) + (Nil-73027 + {Rational-73065}))) + n-73595)))) + (c-73586 + (ParamRational-73072 + ((let + a-73606 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73607 : + all b-73608. + (a-73606 -> + b-73608 -> + b-73608) -> + b-73608 -> + b-73608) -> + g-73607 + {List-73026 + a-73606} + (\(ds-73609 : + a-73606) + (ds-73610 : + List-73026 + a-73606) -> + Cons-73028 + {a-73606} + ds-73609 + ds-73610) + (Nil-73027 + {a-73606})) + (/\a-73611 -> + \(c-73612 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73611 -> + a-73611) + (n-73613 : + a-73611) -> + c-73612 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-73614 + = List-73026 + Rational-73065 + in + \(c-73615 : + Rational-73065 -> + a-73614 -> + a-73614) + (n-73616 : + a-73614) -> + c-73615 + (unsafeRatio-73086 + 1 + 20000) + n-73616) + (\(ds-73617 : + Rational-73065) + (ds-73618 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73617 + ds-73618) + (Nil-73027 + {Rational-73065}))) + (c-73612 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-73619 + = List-73026 + Rational-73065 + in + \(c-73620 : + Rational-73065 -> + a-73619 -> + a-73619) + (n-73621 : + a-73619) -> + c-73620 + (unsafeRatio-73086 + 1 + 5000) + n-73621) + (\(ds-73622 : + Rational-73065) + (ds-73623 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73622 + ds-73623) + (Nil-73027 + {Rational-73065}))) + n-73613)))) + n-73587)) + (\(ds-73624 : + ParamValue-73068) + (ds-73625 : + List-73026 + ParamValue-73068) -> + Cons-73028 + {ParamValue-73068} + ds-73624 + ds-73625) + (Nil-73027 + {ParamValue-73068})))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 20 + (ParamList-73071 + ((let + a-73626 + = List-73026 + ParamValue-73068 + in + \(c-73627 : + ParamValue-73068 -> + a-73626 -> + a-73626) + (n-73628 : + a-73626) -> + c-73627 + (ParamInteger-73070 ((let - a - = Tuple2 - PredKey - (List + a-73629 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List + \(g-73630 : + all b-73631. + (a-73629 -> + b-73631 -> + b-73631) -> + b-73631 -> + b-73631) -> + g-73630 + {List-73026 + a-73629} + (\(ds-73632 : + a-73629) + (ds-73633 : + List-73026 + a-73629) -> + Cons-73028 + {a-73629} + ds-73632 + ds-73633) + (Nil-73027 + {a-73629})) + (/\a-73634 -> + \(c-73635 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List + a-73634 -> + a-73634) + (n-73636 : + a-73634) -> + c-73635 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} - MinValue + MinValue-73052 ((let - a - = List + a-73637 + = List-73026 integer in - \(c : + \(c-73638 : integer -> - a -> - a) - (n : - a) -> - c - 100 - (c - 0 - n)) - (\(ds : + a-73637 -> + a-73637) + (n-73639 : + a-73637) -> + c-73638 + 0 + n-73639) + (\(ds-73640 : integer) - (ds : - List + (ds-73641 : + List-73026 integer) -> - Cons + Cons-73028 {integer} - ds - ds) - (Nil + ds-73640 + ds-73641) + (Nil-73027 {integer}))) - (c - (Tuple2 - {PredKey} - {List + (c-73635 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} - MaxValue + MaxValue-73051 ((let - a - = List + a-73642 + = List-73026 integer in - \(c : + \(c-73643 : integer -> - a -> - a) - (n : - a) -> - c - 200 - n) - (\(ds : + a-73642 -> + a-73642) + (n-73644 : + a-73642) -> + c-73643 + 40000000 + n-73644) + (\(ds-73645 : integer) - (ds : - List + (ds-73646 : + List-73026 integer) -> - Cons + Cons-73028 {integer} - ds - ds) - (Nil + ds-73645 + ds-73646) + (Nil-73027 {integer}))) - (c - (Tuple2 - {PredKey} - {List + n-73636)))) + (c-73627 + (ParamInteger-73070 + ((let + a-73647 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-73648 : + all b-73649. + (a-73647 -> + b-73649 -> + b-73649) -> + b-73649 -> + b-73649) -> + g-73648 + {List-73026 + a-73647} + (\(ds-73650 : + a-73647) + (ds-73651 : + List-73026 + a-73647) -> + Cons-73028 + {a-73647} + ds-73650 + ds-73651) + (Nil-73027 + {a-73647})) + (/\a-73652 -> + \(c-73653 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73652 -> + a-73652) + (n-73654 : + a-73652) -> + c-73653 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-73655 + = List-73026 + integer + in + \(c-73656 : + integer -> + a-73655 -> + a-73655) + (n-73657 : + a-73655) -> + c-73656 + 0 + n-73657) + (\(ds-73658 : + integer) + (ds-73659 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73658 + ds-73659) + (Nil-73027 + {integer}))) + (c-73653 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} - NotEqual + MaxValue-73051 ((let - a - = List + a-73660 + = List-73026 integer in - \(c : + \(c-73661 : integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : + a-73660 -> + a-73660) + (n-73662 : + a-73660) -> + c-73661 + 15000000000 + n-73662) + (\(ds-73663 : integer) - (ds : - List + (ds-73664 : + List-73026 integer) -> - Cons + Cons-73028 {integer} - ds - ds) - (Nil + ds-73663 + ds-73664) + (Nil-73027 {integer}))) - n)))))) - (c - (Tuple2 - {integer} - {ParamValue} - 24 - (ParamInteger + n-73654)))) + n-73628)) + (\(ds-73665 : + ParamValue-73068) + (ds-73666 : + List-73026 + ParamValue-73068) -> + Cons-73028 + {ParamValue-73068} + ds-73665 + ds-73666) + (Nil-73027 + {ParamValue-73068})))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 21 + (ParamList-73071 + ((let + a-73667 + = List-73026 + ParamValue-73068 + in + \(c-73668 : + ParamValue-73068 -> + a-73667 -> + a-73667) + (n-73669 : + a-73667) -> + c-73668 + (ParamInteger-73070 ((let - a - = Tuple2 - PredKey - (List + a-73670 + = Tuple2-73031 + PredKey-73050 + (List-73026 integer) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List + \(g-73671 : + all b-73672. + (a-73670 -> + b-73672 -> + b-73672) -> + b-73672 -> + b-73672) -> + g-73671 + {List-73026 + a-73670} + (\(ds-73673 : + a-73670) + (ds-73674 : + List-73026 + a-73670) -> + Cons-73028 + {a-73670} + ds-73673 + ds-73674) + (Nil-73027 + {a-73670})) + (/\a-73675 -> + \(c-73676 : + Tuple2-73031 + PredKey-73050 + (List-73026 integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List + a-73675 -> + a-73675) + (n-73677 : + a-73675) -> + c-73676 + (Tuple2-73032 + {PredKey-73050} + {List-73026 integer} - MinValue + MinValue-73052 ((let - a - = List + a-73678 + = List-73026 integer in - \(c : + \(c-73679 : integer -> - a -> - a) - (n : - a) -> - c - 1 - n) - (\(ds : + a-73678 -> + a-73678) + (n-73680 : + a-73678) -> + c-73679 + 0 + n-73680) + (\(ds-73681 : integer) - (ds : - List + (ds-73682 : + List-73026 integer) -> - Cons + Cons-73028 {integer} - ds - ds) - (Nil + ds-73681 + ds-73682) + (Nil-73027 {integer}))) - n)))) - (c - (Tuple2 - {integer} - {ParamValue} - 25 - (ParamList + (c-73676 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-73683 + = List-73026 + integer + in + \(c-73684 : + integer -> + a-73683 -> + a-73683) + (n-73685 : + a-73683) -> + c-73684 + 120000000 + n-73685) + (\(ds-73686 : + integer) + (ds-73687 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73686 + ds-73687) + (Nil-73027 + {integer}))) + n-73677)))) + (c-73668 + (ParamInteger-73070 ((let - a - = List - ParamValue + a-73688 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(g-73689 : + all b-73690. + (a-73688 -> + b-73690 -> + b-73690) -> + b-73690 -> + b-73690) -> + g-73689 + {List-73026 + a-73688} + (\(ds-73691 : + a-73688) + (ds-73692 : + List-73026 + a-73688) -> + Cons-73028 + {a-73688} + ds-73691 + ds-73692) + (Nil-73027 + {a-73688})) + (/\a-73693 -> + \(c-73694 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73693 -> + a-73693) + (n-73695 : + a-73693) -> + c-73694 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73696 + = List-73026 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-73697 : + integer -> + a-73696 -> + a-73696) + (n-73698 : + a-73696) -> + c-73697 + 0 + n-73698) + (\(ds-73699 : + integer) + (ds-73700 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73699 + ds-73700) + (Nil-73027 + {integer}))) + (c-73694 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73701 + = List-73026 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 4 - 5) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - n))))) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 26 - (ParamList + \(c-73702 : + integer -> + a-73701 -> + a-73701) + (n-73703 : + a-73701) -> + c-73702 + 40000000000 + n-73703) + (\(ds-73704 : + integer) + (ds-73705 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73704 + ds-73705) + (Nil-73027 + {integer}))) + n-73695)))) + n-73669)) + (\(ds-73706 : + ParamValue-73068) + (ds-73707 : + List-73026 + ParamValue-73068) -> + Cons-73028 + {ParamValue-73068} + ds-73706 + ds-73707) + (Nil-73027 + {ParamValue-73068})))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 22 + (ParamInteger-73070 + ((let + a-73708 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-73709 : + all b-73710. + (a-73708 -> + b-73710 -> + b-73710) -> + b-73710 -> + b-73710) -> + g-73709 + {List-73026 + a-73708} + (\(ds-73711 : + a-73708) + (ds-73712 : + List-73026 + a-73708) -> + Cons-73028 + {a-73708} + ds-73711 + ds-73712) + (Nil-73027 + {a-73708})) + (/\a-73713 -> + \(c-73714 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73713 -> + a-73713) + (n-73715 : + a-73713) -> + c-73714 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 ((let - a - = List - ParamValue + a-73716 + = List-73026 + integer in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-73717 : + integer -> + a-73716 -> + a-73716) + (n-73718 : + a-73716) -> + c-73717 + 0 + n-73718) + (\(ds-73719 : + integer) + (ds-73720 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73719 + ds-73720) + (Nil-73027 + {integer}))) + (c-73714 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-73721 + = List-73026 + integer + in + \(c-73722 : + integer -> + a-73721 -> + a-73721) + (n-73723 : + a-73721) -> + c-73722 + 12288 + n-73723) + (\(ds-73724 : + integer) + (ds-73725 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73724 + ds-73725) + (Nil-73027 + {integer}))) + n-73715))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 23 + (ParamInteger-73070 + ((let + a-73726 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-73727 : + all b-73728. + (a-73726 -> + b-73728 -> + b-73728) -> + b-73728 -> + b-73728) -> + g-73727 + {List-73026 + a-73726} + (\(ds-73729 : + a-73726) + (ds-73730 : + List-73026 + a-73726) -> + Cons-73028 + {a-73726} + ds-73729 + ds-73730) + (Nil-73027 + {a-73726})) + (/\a-73731 -> + \(c-73732 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73731 -> + a-73731) + (n-73733 : + a-73731) -> + c-73732 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-73734 + = List-73026 + integer + in + \(c-73735 : + integer -> + a-73734 -> + a-73734) + (n-73736 : + a-73734) -> + c-73735 + 100 + (c-73735 + 0 + n-73736)) + (\(ds-73737 : + integer) + (ds-73738 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73737 + ds-73738) + (Nil-73027 + {integer}))) + (c-73732 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-73739 + = List-73026 + integer + in + \(c-73740 : + integer -> + a-73739 -> + a-73739) + (n-73741 : + a-73739) -> + c-73740 + 200 + n-73741) + (\(ds-73742 : + integer) + (ds-73743 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73742 + ds-73743) + (Nil-73027 + {integer}))) + (c-73732 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + NotEqual-73053 + ((let + a-73744 + = List-73026 + integer + in + \(c-73745 : + integer -> + a-73744 -> + a-73744) + (n-73746 : + a-73744) -> + c-73745 + 0 + n-73746) + (\(ds-73747 : + integer) + (ds-73748 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73747 + ds-73748) + (Nil-73027 + {integer}))) + n-73733)))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 24 + (ParamInteger-73070 + ((let + a-73749 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-73750 : + all b-73751. + (a-73749 -> + b-73751 -> + b-73751) -> + b-73751 -> + b-73751) -> + g-73750 + {List-73026 + a-73749} + (\(ds-73752 : + a-73749) + (ds-73753 : + List-73026 + a-73749) -> + Cons-73028 + {a-73749} + ds-73752 + ds-73753) + (Nil-73027 + {a-73749})) + (/\a-73754 -> + \(c-73755 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-73754 -> + a-73754) + (n-73756 : + a-73754) -> + c-73755 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-73757 + = List-73026 + integer + in + \(c-73758 : + integer -> + a-73757 -> + a-73757) + (n-73759 : + a-73757) -> + c-73758 + 1 + n-73759) + (\(ds-73760 : + integer) + (ds-73761 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-73760 + ds-73761) + (Nil-73027 + {integer}))) + n-73756)))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 25 + (ParamList-73071 + ((let + a-73762 + = List-73026 + ParamValue-73068 + in + \(c-73763 : + ParamValue-73068 -> + a-73762 -> + a-73762) + (n-73764 : + a-73762) -> + c-73763 + (ParamRational-73072 + ((let + a-73765 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73766 : + all b-73767. + (a-73765 -> + b-73767 -> + b-73767) -> + b-73767 -> + b-73767) -> + g-73766 + {List-73026 + a-73765} + (\(ds-73768 : + a-73765) + (ds-73769 : + List-73026 + a-73765) -> + Cons-73028 + {a-73765} + ds-73768 + ds-73769) + (Nil-73027 + {a-73765})) + (/\a-73770 -> + \(c-73771 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73770 -> + a-73770) + (n-73772 : + a-73770) -> + c-73771 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73773 + = List-73026 + Rational-73065 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-73774 : + Rational-73065 -> + a-73773 -> + a-73773) + (n-73775 : + a-73773) -> + c-73774 + (unsafeRatio-73086 + 1 + 2) + (c-73774 + (unsafeRatio-73086 + 51 + 100) + n-73775)) + (\(ds-73776 : + Rational-73065) + (ds-73777 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73776 + ds-73777) + (Nil-73027 + {Rational-73065}))) + (c-73771 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-73778 + = List-73026 + Rational-73065 + in + \(c-73779 : + Rational-73065 -> + a-73778 -> + a-73778) + (n-73780 : + a-73778) -> + c-73779 + (unsafeRatio-73086 + 1 + 1) + (c-73779 + (unsafeRatio-73086 + 3 + 4) + n-73780)) + (\(ds-73781 : + Rational-73065) + (ds-73782 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73781 + ds-73782) + (Nil-73027 + {Rational-73065}))) + n-73772)))) + (c-73763 + (ParamRational-73072 + ((let + a-73783 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73784 : + all b-73785. + (a-73783 -> + b-73785 -> + b-73785) -> + b-73785 -> + b-73785) -> + g-73784 + {List-73026 + a-73783} + (\(ds-73786 : + a-73783) + (ds-73787 : + List-73026 + a-73783) -> + Cons-73028 + {a-73783} + ds-73786 + ds-73787) + (Nil-73027 + {a-73783})) + (/\a-73788 -> + \(c-73789 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73788 -> + a-73788) + (n-73790 : + a-73788) -> + c-73789 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73791 + = List-73026 + Rational-73065 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 4 - 5) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-73792 : + Rational-73065 -> + a-73791 -> + a-73791) + (n-73793 : + a-73791) -> + c-73792 + (unsafeRatio-73086 + 1 + 2) + (c-73792 + (unsafeRatio-73086 + 13 + 20) + n-73793)) + (\(ds-73794 : + Rational-73065) + (ds-73795 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73794 + ds-73795) + (Nil-73027 + {Rational-73065}))) + (c-73789 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73796 + = List-73026 + Rational-73065 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-73797 : + Rational-73065 -> + a-73796 -> + a-73796) + (n-73798 : + a-73796) -> + c-73797 + (unsafeRatio-73086 + 1 + 1) + (c-73797 + (unsafeRatio-73086 + 9 + 10) + n-73798)) + (\(ds-73799 : + Rational-73065) + (ds-73800 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73799 + ds-73800) + (Nil-73027 + {Rational-73065}))) + n-73790)))) + (c-73763 + (ParamRational-73072 + ((let + a-73801 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73802 : + all b-73803. + (a-73801 -> + b-73803 -> + b-73803) -> + b-73803 -> + b-73803) -> + g-73802 + {List-73026 + a-73801} + (\(ds-73804 : + a-73801) + (ds-73805 : + List-73026 + a-73801) -> + Cons-73028 + {a-73801} + ds-73804 + ds-73805) + (Nil-73027 + {a-73801})) + (/\a-73806 -> + \(c-73807 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73806 -> + a-73806) + (n-73808 : + a-73806) -> + c-73807 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-73809 + = List-73026 + Rational-73065 + in + \(c-73810 : + Rational-73065 -> + a-73809 -> + a-73809) + (n-73811 : + a-73809) -> + c-73810 + (unsafeRatio-73086 + 1 + 2) + (c-73810 + (unsafeRatio-73086 + 13 + 20) + n-73811)) + (\(ds-73812 : + Rational-73065) + (ds-73813 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73812 + ds-73813) + (Nil-73027 + {Rational-73065}))) + (c-73807 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-73814 + = List-73026 + Rational-73065 + in + \(c-73815 : + Rational-73065 -> + a-73814 -> + a-73814) + (n-73816 : + a-73814) -> + c-73815 + (unsafeRatio-73086 + 1 + 1) + (c-73815 + (unsafeRatio-73086 + 9 + 10) + n-73816)) + (\(ds-73817 : + Rational-73065) + (ds-73818 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73817 + ds-73818) + (Nil-73027 + {Rational-73065}))) + n-73808)))) + (c-73763 + (ParamRational-73072 + ((let + a-73819 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73820 : + all b-73821. + (a-73819 -> + b-73821 -> + b-73821) -> + b-73821 -> + b-73821) -> + g-73820 + {List-73026 + a-73819} + (\(ds-73822 : + a-73819) + (ds-73823 : + List-73026 + a-73819) -> + Cons-73028 + {a-73819} + ds-73822 + ds-73823) + (Nil-73027 + {a-73819})) + (/\a-73824 -> + \(c-73825 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73824 -> + a-73824) + (n-73826 : + a-73824) -> + c-73825 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73827 + = List-73026 + Rational-73065 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-73828 : + Rational-73065 -> + a-73827 -> + a-73827) + (n-73829 : + a-73827) -> + c-73828 + (unsafeRatio-73086 + 1 + 2) + (c-73828 + (unsafeRatio-73086 + 51 + 100) + n-73829)) + (\(ds-73830 : + Rational-73065) + (ds-73831 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73830 + ds-73831) + (Nil-73027 + {Rational-73065}))) + (c-73825 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-73832 + = List-73026 + Rational-73065 + in + \(c-73833 : + Rational-73065 -> + a-73832 -> + a-73832) + (n-73834 : + a-73832) -> + c-73833 + (unsafeRatio-73086 + 1 + 1) + (c-73833 + (unsafeRatio-73086 + 4 + 5) + n-73834)) + (\(ds-73835 : + Rational-73065) + (ds-73836 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73835 + ds-73836) + (Nil-73027 + {Rational-73065}))) + n-73826)))) + (c-73763 + (ParamRational-73072 + ((let + a-73837 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73838 : + all b-73839. + (a-73837 -> + b-73839 -> + b-73839) -> + b-73839 -> + b-73839) -> + g-73838 + {List-73026 + a-73837} + (\(ds-73840 : + a-73837) + (ds-73841 : + List-73026 + a-73837) -> + Cons-73028 + {a-73837} + ds-73840 + ds-73841) + (Nil-73027 + {a-73837})) + (/\a-73842 -> + \(c-73843 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73842 -> + a-73842) + (n-73844 : + a-73842) -> + c-73843 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73845 + = List-73026 + Rational-73065 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-73846 : + Rational-73065 -> + a-73845 -> + a-73845) + (n-73847 : + a-73845) -> + c-73846 + (unsafeRatio-73086 + 1 + 2) + n-73847) + (\(ds-73848 : + Rational-73065) + (ds-73849 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73848 + ds-73849) + (Nil-73027 + {Rational-73065}))) + (c-73843 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73850 + = List-73026 + Rational-73065 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - n)))))))))) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 27 - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - (c - 3 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 10 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 28 - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - (c - 18 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 293 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - NotEqual - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))))) - (c - (Tuple2 - {integer} - {ParamValue} - 29 - (ParamInteger + \(c-73851 : + Rational-73065 -> + a-73850 -> + a-73850) + (n-73852 : + a-73850) -> + c-73851 + (unsafeRatio-73086 + 1 + 1) + n-73852) + (\(ds-73853 : + Rational-73065) + (ds-73854 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73853 + ds-73854) + (Nil-73027 + {Rational-73065}))) + n-73844)))) + n-73764))))) + (\(ds-73855 : + ParamValue-73068) + (ds-73856 : + List-73026 + ParamValue-73068) -> + Cons-73028 + {ParamValue-73068} + ds-73855 + ds-73856) + (Nil-73027 + {ParamValue-73068})))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 26 + (ParamList-73071 + ((let + a-73857 + = List-73026 + ParamValue-73068 + in + \(c-73858 : + ParamValue-73068 -> + a-73857 -> + a-73857) + (n-73859 : + a-73857) -> + c-73858 + (ParamRational-73072 ((let - a - = Tuple2 - PredKey - (List - integer) + a-73860 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-73861 : + all b-73862. + (a-73860 -> + b-73862 -> + b-73862) -> + b-73862 -> + b-73862) -> + g-73861 + {List-73026 + a-73860} + (\(ds-73863 : + a-73860) + (ds-73864 : + List-73026 + a-73860) -> + Cons-73028 + {a-73860} + ds-73863 + ds-73864) + (Nil-73027 + {a-73860})) + (/\a-73865 -> + \(c-73866 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73865 -> + a-73865) + (n-73867 : + a-73865) -> + c-73866 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = List - integer + a-73868 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 1 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-73869 : + Rational-73065 -> + a-73868 -> + a-73868) + (n-73870 : + a-73868) -> + c-73869 + (unsafeRatio-73086 + 1 + 2) + (c-73869 + (unsafeRatio-73086 + 51 + 100) + n-73870)) + (\(ds-73871 : + Rational-73065) + (ds-73872 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73871 + ds-73872) + (Nil-73027 + {Rational-73065}))) + (c-73866 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = List - integer + a-73873 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 15 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 30 - (ParamInteger + \(c-73874 : + Rational-73065 -> + a-73873 -> + a-73873) + (n-73875 : + a-73873) -> + c-73874 + (unsafeRatio-73086 + 1 + 1) + (c-73874 + (unsafeRatio-73086 + 3 + 4) + n-73875)) + (\(ds-73876 : + Rational-73065) + (ds-73877 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73876 + ds-73877) + (Nil-73027 + {Rational-73065}))) + n-73867)))) + (c-73858 + (ParamRational-73072 ((let - a - = Tuple2 - PredKey - (List - integer) + a-73878 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-73879 : + all b-73880. + (a-73878 -> + b-73880 -> + b-73880) -> + b-73880 -> + b-73880) -> + g-73879 + {List-73026 + a-73878} + (\(ds-73881 : + a-73878) + (ds-73882 : + List-73026 + a-73878) -> + Cons-73028 + {a-73878} + ds-73881 + ds-73882) + (Nil-73027 + {a-73878})) + (/\a-73883 -> + \(c-73884 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73883 -> + a-73883) + (n-73885 : + a-73883) -> + c-73884 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = List - integer + a-73886 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - (c - 1000000 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-73887 : + Rational-73065 -> + a-73886 -> + a-73886) + (n-73888 : + a-73886) -> + c-73887 + (unsafeRatio-73086 + 1 + 2) + (c-73887 + (unsafeRatio-73086 + 13 + 20) + n-73888)) + (\(ds-73889 : + Rational-73065) + (ds-73890 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73889 + ds-73890) + (Nil-73027 + {Rational-73065}))) + (c-73884 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = List - integer + a-73891 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 10000000000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 31 - (ParamInteger + \(c-73892 : + Rational-73065 -> + a-73891 -> + a-73891) + (n-73893 : + a-73891) -> + c-73892 + (unsafeRatio-73086 + 1 + 1) + (c-73892 + (unsafeRatio-73086 + 9 + 10) + n-73893)) + (\(ds-73894 : + Rational-73065) + (ds-73895 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73894 + ds-73895) + (Nil-73027 + {Rational-73065}))) + n-73885)))) + (c-73858 + (ParamRational-73072 ((let - a - = Tuple2 - PredKey - (List - integer) + a-73896 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-73897 : + all b-73898. + (a-73896 -> + b-73898 -> + b-73898) -> + b-73898 -> + b-73898) -> + g-73897 + {List-73026 + a-73896} + (\(ds-73899 : + a-73896) + (ds-73900 : + List-73026 + a-73896) -> + Cons-73028 + {a-73896} + ds-73899 + ds-73900) + (Nil-73027 + {a-73896})) + (/\a-73901 -> + \(c-73902 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73901 -> + a-73901) + (n-73903 : + a-73901) -> + c-73902 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = List - integer + a-73904 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - (c - 1000000 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-73905 : + Rational-73065 -> + a-73904 -> + a-73904) + (n-73906 : + a-73904) -> + c-73905 + (unsafeRatio-73086 + 1 + 2) + (c-73905 + (unsafeRatio-73086 + 13 + 20) + n-73906)) + (\(ds-73907 : + Rational-73065) + (ds-73908 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73907 + ds-73908) + (Nil-73027 + {Rational-73065}))) + (c-73902 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = List - integer + a-73909 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 100000000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 32 - (ParamInteger + \(c-73910 : + Rational-73065 -> + a-73909 -> + a-73909) + (n-73911 : + a-73909) -> + c-73910 + (unsafeRatio-73086 + 1 + 1) + (c-73910 + (unsafeRatio-73086 + 9 + 10) + n-73911)) + (\(ds-73912 : + Rational-73065) + (ds-73913 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73912 + ds-73913) + (Nil-73027 + {Rational-73065}))) + n-73903)))) + (c-73858 + (ParamRational-73072 ((let - a - = Tuple2 - PredKey - (List - integer) + a-73914 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-73915 : + all b-73916. + (a-73914 -> + b-73916 -> + b-73916) -> + b-73916 -> + b-73916) -> + g-73915 + {List-73026 + a-73914} + (\(ds-73917 : + a-73914) + (ds-73918 : + List-73026 + a-73914) -> + Cons-73028 + {a-73914} + ds-73917 + ds-73918) + (Nil-73027 + {a-73914})) + (/\a-73919 -> + \(c-73920 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73919 -> + a-73919) + (n-73921 : + a-73919) -> + c-73920 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = List - integer + a-73922 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 13 - (c - 0 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-73923 : + Rational-73065 -> + a-73922 -> + a-73922) + (n-73924 : + a-73922) -> + c-73923 + (unsafeRatio-73086 + 1 + 2) + (c-73923 + (unsafeRatio-73086 + 13 + 20) + n-73924)) + (\(ds-73925 : + Rational-73065) + (ds-73926 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73925 + ds-73926) + (Nil-73027 + {Rational-73065}))) + (c-73920 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = List - integer + a-73927 + = List-73026 + Rational-73065 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 37 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 33 - (ParamRational + \(c-73928 : + Rational-73065 -> + a-73927 -> + a-73927) + (n-73929 : + a-73927) -> + c-73928 + (unsafeRatio-73086 + 1 + 1) + (c-73928 + (unsafeRatio-73086 + 9 + 10) + n-73929)) + (\(ds-73930 : + Rational-73065) + (ds-73931 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73930 + ds-73931) + (Nil-73027 + {Rational-73065}))) + n-73921)))) + (c-73858 + (ParamRational-73072 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-73932 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue + \(g-73933 : + all b-73934. + (a-73932 -> + b-73934 -> + b-73934) -> + b-73934 -> + b-73934) -> + g-73933 + {List-73026 + a-73932} + (\(ds-73935 : + a-73932) + (ds-73936 : + List-73026 + a-73932) -> + Cons-73028 + {a-73932} + ds-73935 + ds-73936) + (Nil-73027 + {a-73932})) + (/\a-73937 -> + \(c-73938 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73937 -> + a-73937) + (n-73939 : + a-73937) -> + c-73938 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 ((let - a - = List - Rational + a-73940 + = List-73026 + Rational-73065 in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 0 - 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue + \(c-73941 : + Rational-73065 -> + a-73940 -> + a-73940) + (n-73942 : + a-73940) -> + c-73941 + (unsafeRatio-73086 + 1 + 2) + (c-73941 + (unsafeRatio-73086 + 51 + 100) + n-73942)) + (\(ds-73943 : + Rational-73065) + (ds-73944 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73943 + ds-73944) + (Nil-73027 + {Rational-73065}))) + (c-73938 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 ((let - a - = List - Rational + a-73945 + = List-73026 + Rational-73065 in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1000 + \(c-73946 : + Rational-73065 -> + a-73945 -> + a-73945) + (n-73947 : + a-73945) -> + c-73946 + (unsafeRatio-73086 + 1 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n))))) - n))))))))))))))))))))))))))))))) - in - \(ds : data) -> - Maybe_match - {List (Tuple2 data data)} - (let - !ds : data - = headList - {data} - (tailList - {data} - (tailList - {data} - (sndPair - {integer} - {list data} - (unConstrData - (let - !ds : data - = headList - {data} - (tailList - {data} - (tailList - {data} - (sndPair - {integer} - {list data} - (unConstrData ds)))) - ~si : pair integer (list data) = unConstrData ds - in - Bool_match - (ifThenElse - {Bool} - (equalsInteger - 5 - (fstPair {integer} {list data} si)) - True - False) - {all dead. data} - (/\dead -> - headList + (c-73946 + (unsafeRatio-73086 + 4 + 5) + n-73947)) + (\(ds-73948 : + Rational-73065) + (ds-73949 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73948 + ds-73949) + (Nil-73027 + {Rational-73065}))) + n-73939)))) + (c-73858 + (ParamRational-73072 + ((let + a-73950 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73951 : + all b-73952. + (a-73950 -> + b-73952 -> + b-73952) -> + b-73952 -> + b-73952) -> + g-73951 + {List-73026 + a-73950} + (\(ds-73953 : + a-73950) + (ds-73954 : + List-73026 + a-73950) -> + Cons-73028 + {a-73950} + ds-73953 + ds-73954) + (Nil-73027 + {a-73950})) + (/\a-73955 -> + \(c-73956 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73955 -> + a-73955) + (n-73957 : + a-73955) -> + c-73956 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-73958 + = List-73026 + Rational-73065 + in + \(c-73959 : + Rational-73065 -> + a-73958 -> + a-73958) + (n-73960 : + a-73958) -> + c-73959 + (unsafeRatio-73086 + 1 + 2) + (c-73959 + (unsafeRatio-73086 + 51 + 100) + n-73960)) + (\(ds-73961 : + Rational-73065) + (ds-73962 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73961 + ds-73962) + (Nil-73027 + {Rational-73065}))) + (c-73956 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-73963 + = List-73026 + Rational-73065 + in + \(c-73964 : + Rational-73065 -> + a-73963 -> + a-73963) + (n-73965 : + a-73963) -> + c-73964 + (unsafeRatio-73086 + 1 + 1) + (c-73964 + (unsafeRatio-73086 + 3 + 4) + n-73965)) + (\(ds-73966 : + Rational-73065) + (ds-73967 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73966 + ds-73967) + (Nil-73027 + {Rational-73065}))) + n-73957)))) + (c-73858 + (ParamRational-73072 + ((let + a-73968 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73969 : + all b-73970. + (a-73968 -> + b-73970 -> + b-73970) -> + b-73970 -> + b-73970) -> + g-73969 + {List-73026 + a-73968} + (\(ds-73971 : + a-73968) + (ds-73972 : + List-73026 + a-73968) -> + Cons-73028 + {a-73968} + ds-73971 + ds-73972) + (Nil-73027 + {a-73968})) + (/\a-73973 -> + \(c-73974 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73973 -> + a-73973) + (n-73975 : + a-73973) -> + c-73974 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-73976 + = List-73026 + Rational-73065 + in + \(c-73977 : + Rational-73065 -> + a-73976 -> + a-73976) + (n-73978 : + a-73976) -> + c-73977 + (unsafeRatio-73086 + 1 + 2) + (c-73977 + (unsafeRatio-73086 + 51 + 100) + n-73978)) + (\(ds-73979 : + Rational-73065) + (ds-73980 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73979 + ds-73980) + (Nil-73027 + {Rational-73065}))) + (c-73974 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-73981 + = List-73026 + Rational-73065 + in + \(c-73982 : + Rational-73065 -> + a-73981 -> + a-73981) + (n-73983 : + a-73981) -> + c-73982 + (unsafeRatio-73086 + 1 + 1) + (c-73982 + (unsafeRatio-73086 + 3 + 4) + n-73983)) + (\(ds-73984 : + Rational-73065) + (ds-73985 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73984 + ds-73985) + (Nil-73027 + {Rational-73065}))) + n-73975)))) + (c-73858 + (ParamRational-73072 + ((let + a-73986 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-73987 : + all b-73988. + (a-73986 -> + b-73988 -> + b-73988) -> + b-73988 -> + b-73988) -> + g-73987 + {List-73026 + a-73986} + (\(ds-73989 : + a-73986) + (ds-73990 : + List-73026 + a-73986) -> + Cons-73028 + {a-73986} + ds-73989 + ds-73990) + (Nil-73027 + {a-73986})) + (/\a-73991 -> + \(c-73992 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-73991 -> + a-73991) + (n-73993 : + a-73991) -> + c-73992 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-73994 + = List-73026 + Rational-73065 + in + \(c-73995 : + Rational-73065 -> + a-73994 -> + a-73994) + (n-73996 : + a-73994) -> + c-73995 + (unsafeRatio-73086 + 1 + 2) + (c-73995 + (unsafeRatio-73086 + 51 + 100) + n-73996)) + (\(ds-73997 : + Rational-73065) + (ds-73998 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-73997 + ds-73998) + (Nil-73027 + {Rational-73065}))) + (c-73992 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-73999 + = List-73026 + Rational-73065 + in + \(c-74000 : + Rational-73065 -> + a-73999 -> + a-73999) + (n-74001 : + a-73999) -> + c-74000 + (unsafeRatio-73086 + 1 + 1) + (c-74000 + (unsafeRatio-73086 + 3 + 4) + n-74001)) + (\(ds-74002 : + Rational-73065) + (ds-74003 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-74002 + ds-74003) + (Nil-73027 + {Rational-73065}))) + n-73993)))) + (c-73858 + (ParamRational-73072 + ((let + a-74004 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-74005 : + all b-74006. + (a-74004 -> + b-74006 -> + b-74006) -> + b-74006 -> + b-74006) -> + g-74005 + {List-73026 + a-74004} + (\(ds-74007 : + a-74004) + (ds-74008 : + List-73026 + a-74004) -> + Cons-73028 + {a-74004} + ds-74007 + ds-74008) + (Nil-73027 + {a-74004})) + (/\a-74009 -> + \(c-74010 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-74009 -> + a-74009) + (n-74011 : + a-74009) -> + c-74010 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-74012 + = List-73026 + Rational-73065 + in + \(c-74013 : + Rational-73065 -> + a-74012 -> + a-74012) + (n-74014 : + a-74012) -> + c-74013 + (unsafeRatio-73086 + 1 + 2) + (c-74013 + (unsafeRatio-73086 + 3 + 4) + n-74014)) + (\(ds-74015 : + Rational-73065) + (ds-74016 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-74015 + ds-74016) + (Nil-73027 + {Rational-73065}))) + (c-74010 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-74017 + = List-73026 + Rational-73065 + in + \(c-74018 : + Rational-73065 -> + a-74017 -> + a-74017) + (n-74019 : + a-74017) -> + c-74018 + (unsafeRatio-73086 + 1 + 1) + (c-74018 + (unsafeRatio-73086 + 9 + 10) + n-74019)) + (\(ds-74020 : + Rational-73065) + (ds-74021 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-74020 + ds-74021) + (Nil-73027 + {Rational-73065}))) + n-74011)))) + (c-73858 + (ParamRational-73072 + ((let + a-74022 + = Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) + in + \(g-74023 : + all b-74024. + (a-74022 -> + b-74024 -> + b-74024) -> + b-74024 -> + b-74024) -> + g-74023 + {List-73026 + a-74022} + (\(ds-74025 : + a-74022) + (ds-74026 : + List-73026 + a-74022) -> + Cons-73028 + {a-74022} + ds-74025 + ds-74026) + (Nil-73027 + {a-74022})) + (/\a-74027 -> + \(c-74028 : + Tuple2-73031 + PredKey-73050 + (List-73026 + Rational-73065) -> + a-74027 -> + a-74027) + (n-74029 : + a-74027) -> + c-74028 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MinValue-73052 + ((let + a-74030 + = List-73026 + Rational-73065 + in + \(c-74031 : + Rational-73065 -> + a-74030 -> + a-74030) + (n-74032 : + a-74030) -> + c-74031 + (unsafeRatio-73086 + 1 + 2) + n-74032) + (\(ds-74033 : + Rational-73065) + (ds-74034 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-74033 + ds-74034) + (Nil-73027 + {Rational-73065}))) + (c-74028 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + Rational-73065} + MaxValue-73051 + ((let + a-74035 + = List-73026 + Rational-73065 + in + \(c-74036 : + Rational-73065 -> + a-74035 -> + a-74035) + (n-74037 : + a-74035) -> + c-74036 + (unsafeRatio-73086 + 1 + 1) + n-74037) + (\(ds-74038 : + Rational-73065) + (ds-74039 : + List-73026 + Rational-73065) -> + Cons-73028 + {Rational-73065} + ds-74038 + ds-74039) + (Nil-73027 + {Rational-73065}))) + n-74029)))) + n-73859)))))))))) + (\(ds-74040 : + ParamValue-73068) + (ds-74041 : + List-73026 + ParamValue-73068) -> + Cons-73028 + {ParamValue-73068} + ds-74040 + ds-74041) + (Nil-73027 + {ParamValue-73068})))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 27 + (ParamInteger-73070 + ((let + a-74042 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-74043 : + all b-74044. + (a-74042 -> + b-74044 -> + b-74044) -> + b-74044 -> + b-74044) -> + g-74043 + {List-73026 + a-74042} + (\(ds-74045 : + a-74042) + (ds-74046 : + List-73026 + a-74042) -> + Cons-73028 + {a-74042} + ds-74045 + ds-74046) + (Nil-73027 + {a-74042})) + (/\a-74047 -> + \(c-74048 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-74047 -> + a-74047) + (n-74049 : + a-74047) -> + c-74048 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-74050 + = List-73026 + integer + in + \(c-74051 : + integer -> + a-74050 -> + a-74050) + (n-74052 : + a-74050) -> + c-74051 + 0 + (c-74051 + 3 + n-74052)) + (\(ds-74053 : + integer) + (ds-74054 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74053 + ds-74054) + (Nil-73027 + {integer}))) + (c-74048 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-74055 + = List-73026 + integer + in + \(c-74056 : + integer -> + a-74055 -> + a-74055) + (n-74057 : + a-74055) -> + c-74056 + 10 + n-74057) + (\(ds-74058 : + integer) + (ds-74059 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74058 + ds-74059) + (Nil-73027 + {integer}))) + n-74049))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 28 + (ParamInteger-73070 + ((let + a-74060 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-74061 : + all b-74062. + (a-74060 -> + b-74062 -> + b-74062) -> + b-74062 -> + b-74062) -> + g-74061 + {List-73026 + a-74060} + (\(ds-74063 : + a-74060) + (ds-74064 : + List-73026 + a-74060) -> + Cons-73028 + {a-74060} + ds-74063 + ds-74064) + (Nil-73027 + {a-74060})) + (/\a-74065 -> + \(c-74066 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-74065 -> + a-74065) + (n-74067 : + a-74065) -> + c-74066 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-74068 + = List-73026 + integer + in + \(c-74069 : + integer -> + a-74068 -> + a-74068) + (n-74070 : + a-74068) -> + c-74069 + 0 + (c-74069 + 18 + n-74070)) + (\(ds-74071 : + integer) + (ds-74072 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74071 + ds-74072) + (Nil-73027 + {integer}))) + (c-74066 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-74073 + = List-73026 + integer + in + \(c-74074 : + integer -> + a-74073 -> + a-74073) + (n-74075 : + a-74073) -> + c-74074 + 293 + n-74075) + (\(ds-74076 : + integer) + (ds-74077 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74076 + ds-74077) + (Nil-73027 + {integer}))) + (c-74066 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + NotEqual-73053 + ((let + a-74078 + = List-73026 + integer + in + \(c-74079 : + integer -> + a-74078 -> + a-74078) + (n-74080 : + a-74078) -> + c-74079 + 0 + n-74080) + (\(ds-74081 : + integer) + (ds-74082 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74081 + ds-74082) + (Nil-73027 + {integer}))) + n-74067)))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 29 + (ParamInteger-73070 + ((let + a-74083 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-74084 : + all b-74085. + (a-74083 -> + b-74085 -> + b-74085) -> + b-74085 -> + b-74085) -> + g-74084 + {List-73026 + a-74083} + (\(ds-74086 : + a-74083) + (ds-74087 : + List-73026 + a-74083) -> + Cons-73028 + {a-74083} + ds-74086 + ds-74087) + (Nil-73027 + {a-74083})) + (/\a-74088 -> + \(c-74089 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-74088 -> + a-74088) + (n-74090 : + a-74088) -> + c-74089 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-74091 + = List-73026 + integer + in + \(c-74092 : + integer -> + a-74091 -> + a-74091) + (n-74093 : + a-74091) -> + c-74092 + 1 + n-74093) + (\(ds-74094 : + integer) + (ds-74095 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74094 + ds-74095) + (Nil-73027 + {integer}))) + (c-74089 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-74096 + = List-73026 + integer + in + \(c-74097 : + integer -> + a-74096 -> + a-74096) + (n-74098 : + a-74096) -> + c-74097 + 15 + n-74098) + (\(ds-74099 : + integer) + (ds-74100 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74099 + ds-74100) + (Nil-73027 + {integer}))) + n-74090))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 30 + (ParamInteger-73070 + ((let + a-74101 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-74102 : + all b-74103. + (a-74101 -> + b-74103 -> + b-74103) -> + b-74103 -> + b-74103) -> + g-74102 + {List-73026 + a-74101} + (\(ds-74104 : + a-74101) + (ds-74105 : + List-73026 + a-74101) -> + Cons-73028 + {a-74101} + ds-74104 + ds-74105) + (Nil-73027 + {a-74101})) + (/\a-74106 -> + \(c-74107 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-74106 -> + a-74106) + (n-74108 : + a-74106) -> + c-74107 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-74109 + = List-73026 + integer + in + \(c-74110 : + integer -> + a-74109 -> + a-74109) + (n-74111 : + a-74109) -> + c-74110 + 0 + (c-74110 + 1000000 + n-74111)) + (\(ds-74112 : + integer) + (ds-74113 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74112 + ds-74113) + (Nil-73027 + {integer}))) + (c-74107 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-74114 + = List-73026 + integer + in + \(c-74115 : + integer -> + a-74114 -> + a-74114) + (n-74116 : + a-74114) -> + c-74115 + 10000000000000 + n-74116) + (\(ds-74117 : + integer) + (ds-74118 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74117 + ds-74118) + (Nil-73027 + {integer}))) + n-74108))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 31 + (ParamInteger-73070 + ((let + a-74119 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-74120 : + all b-74121. + (a-74119 -> + b-74121 -> + b-74121) -> + b-74121 -> + b-74121) -> + g-74120 + {List-73026 + a-74119} + (\(ds-74122 : + a-74119) + (ds-74123 : + List-73026 + a-74119) -> + Cons-73028 + {a-74119} + ds-74122 + ds-74123) + (Nil-73027 + {a-74119})) + (/\a-74124 -> + \(c-74125 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-74124 -> + a-74124) + (n-74126 : + a-74124) -> + c-74125 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-74127 + = List-73026 + integer + in + \(c-74128 : + integer -> + a-74127 -> + a-74127) + (n-74129 : + a-74127) -> + c-74128 + 0 + (c-74128 + 1000000 + n-74129)) + (\(ds-74130 : + integer) + (ds-74131 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74130 + ds-74131) + (Nil-73027 + {integer}))) + (c-74125 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-74132 + = List-73026 + integer + in + \(c-74133 : + integer -> + a-74132 -> + a-74132) + (n-74134 : + a-74132) -> + c-74133 + 100000000000 + n-74134) + (\(ds-74135 : + integer) + (ds-74136 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74135 + ds-74136) + (Nil-73027 + {integer}))) + n-74126))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 32 + (ParamInteger-73070 + ((let + a-74137 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-74138 : + all b-74139. + (a-74137 -> + b-74139 -> + b-74139) -> + b-74139 -> + b-74139) -> + g-74138 + {List-73026 + a-74137} + (\(ds-74140 : + a-74137) + (ds-74141 : + List-73026 + a-74137) -> + Cons-73028 + {a-74137} + ds-74140 + ds-74141) + (Nil-73027 + {a-74137})) + (/\a-74142 -> + \(c-74143 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-74142 -> + a-74142) + (n-74144 : + a-74142) -> + c-74143 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-74145 + = List-73026 + integer + in + \(c-74146 : + integer -> + a-74145 -> + a-74145) + (n-74147 : + a-74145) -> + c-74146 + 13 + (c-74146 + 0 + n-74147)) + (\(ds-74148 : + integer) + (ds-74149 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74148 + ds-74149) + (Nil-73027 + {integer}))) + (c-74143 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-74150 + = List-73026 + integer + in + \(c-74151 : + integer -> + a-74150 -> + a-74150) + (n-74152 : + a-74150) -> + c-74151 + 37 + n-74152) + (\(ds-74153 : + integer) + (ds-74154 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74153 + ds-74154) + (Nil-73027 + {integer}))) + n-74144))))) + (c-73326 + (Tuple2-73032 + {integer} + {ParamValue-73068} + 33 + (ParamInteger-73070 + ((let + a-74155 + = Tuple2-73031 + PredKey-73050 + (List-73026 + integer) + in + \(g-74156 : + all b-74157. + (a-74155 -> + b-74157 -> + b-74157) -> + b-74157 -> + b-74157) -> + g-74156 + {List-73026 + a-74155} + (\(ds-74158 : + a-74155) + (ds-74159 : + List-73026 + a-74155) -> + Cons-73028 + {a-74155} + ds-74158 + ds-74159) + (Nil-73027 + {a-74155})) + (/\a-74160 -> + \(c-74161 : + Tuple2-73031 + PredKey-73050 + (List-73026 + integer) -> + a-74160 -> + a-74160) + (n-74162 : + a-74160) -> + c-74161 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MinValue-73052 + ((let + a-74163 + = List-73026 + integer + in + \(c-74164 : + integer -> + a-74163 -> + a-74163) + (n-74165 : + a-74163) -> + c-74164 + 0 + n-74165) + (\(ds-74166 : + integer) + (ds-74167 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74166 + ds-74167) + (Nil-73027 + {integer}))) + (c-74161 + (Tuple2-73032 + {PredKey-73050} + {List-73026 + integer} + MaxValue-73051 + ((let + a-74168 + = List-73026 + integer + in + \(c-74169 : + integer -> + a-74168 -> + a-74168) + (n-74170 : + a-74168) -> + c-74169 + 1000 + n-74170) + (\(ds-74171 : + integer) + (ds-74172 : + List-73026 + integer) -> + Cons-73028 + {integer} + ds-74171 + ds-74172) + (Nil-73027 + {integer}))) + n-74162))))) + n-73327))))))))))))))))))))))))))))))) + in + \(ds-74174 : data) -> + Maybe_match-73044 + {List-73026 (Tuple2-73031 data data)} + (let + !ds-74181 : data + = headList + {data} + (tailList + {data} + (tailList + {data} + (sndPair + {integer} + {list data} + (unConstrData + (let + !ds-74175 : data + = headList {data} (tailList {data} - (sndPair {integer} {list data} si))) - (/\dead -> error {data}) - {all dead. dead}))))) - ~ds : pair integer (list data) = unConstrData ds - !x : integer = fstPair {integer} {list data} ds - in - Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) - {all dead. Maybe (List (Tuple2 data data))} - (/\dead -> - Just - {List (Tuple2 data data)} - (go - (unMapData - (headList - {data} - (tailList {data} (sndPair {integer} {list data} ds)))))) - (/\dead -> - Bool_match - (ifThenElse {Bool} (equalsInteger 2 x) True False) - {all dead. Maybe (List (Tuple2 data data))} - (/\dead -> Nothing {List (Tuple2 data data)}) - (/\dead -> error {Maybe (List (Tuple2 data data))}) - {all dead. dead}) - {all dead. dead}) - {all dead. unit} - (\(cparams : List (Tuple2 data data)) -> - /\dead -> - Bool_match - (fun cparams) - {all dead. unit} - (/\dead -> ()) - (/\dead -> error {unit}) - {all dead. dead}) - (/\dead -> ()) - {all dead. dead})) \ No newline at end of file + (tailList + {data} + (sndPair + {integer} + {list data} + (unConstrData ds-74174)))) + ~si-74176 : pair integer (list data) + = unConstrData ds-74175 + in + Bool_match-73049 + (ifThenElse + {Bool-73046} + (equalsInteger + 5 + (fstPair {integer} {list data} si-74176)) + True-73047 + False-73048) + {all dead-74177. data} + (/\dead-74178 -> + headList + {data} + (tailList + {data} + (sndPair {integer} {list data} si-74176))) + (/\dead-74179 -> error {data}) + {all dead-74180. dead-74180}))))) + ~ds-74182 : pair integer (list data) = unConstrData ds-74181 + !x-74183 : integer = fstPair {integer} {list data} ds-74182 + in + Bool_match-73049 + (ifThenElse + {Bool-73046} + (equalsInteger 0 x-74183) + True-73047 + False-73048) + {all dead-74184. Maybe-73041 (List-73026 (Tuple2-73031 data data))} + (/\dead-74185 -> + Just-73042 + {List-73026 (Tuple2-73031 data data)} + (go-73036 + (unMapData + (headList + {data} + (tailList + {data} + (sndPair {integer} {list data} ds-74182)))))) + (/\dead-74186 -> + Bool_match-73049 + (ifThenElse + {Bool-73046} + (equalsInteger 2 x-74183) + True-73047 + False-73048) + {all dead-74187. Maybe-73041 (List-73026 (Tuple2-73031 data data))} + (/\dead-74188 -> + Nothing-73043 {List-73026 (Tuple2-73031 data data)}) + (/\dead-74189 -> + error {Maybe-73041 (List-73026 (Tuple2-73031 data data))}) + {all dead-74190. dead-74190}) + {all dead-74191. dead-74191}) + {all dead-74192. unit} + (\(cparams-74193 : List-73026 (Tuple2-73031 data data)) -> + /\dead-74194 -> + Bool_match-73049 + (fun-74173 cparams-74193) + {all dead-74195. unit} + (/\dead-74196 -> ()) + (/\dead-74197 -> error {unit}) + {all dead-74198. dead-74198}) + (/\dead-74199 -> ()) + {all dead-74200. dead-74200}) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden index cb963ac39a9..f13a8433773 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/sorted.uplc.golden @@ -1,423 +1,394 @@ -(program - 1.1.0 - ((\fix1 -> - (\`$fOrdRational0_$c<=` -> - (\`$fOrdInteger_$ccompare` -> - (\validatePreds -> - (\euclid -> - (\unsafeRatio -> - (\cse -> - (\validateParamValue -> - (\validateParamValues -> - (\runRules -> - (\go -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\fun - ds -> - force - (case - ((\cse -> - (\x -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - x) - (delay - (delay - (constr 0 - [ (go - (unMapData +program + 1.1.0 + ((\fix1!0 -> + (\`$fOrdRational0_$c<=`!0 -> + (\`$fOrdInteger_$ccompare`!0 -> + (\validatePreds!0 -> + (\euclid!0 -> + (\unsafeRatio!0 -> + (\cse!0 -> + (\validateParamValue!0 -> + (\validateParamValues!0 -> + (\runRules!0 -> + (\go!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\fun!0 + ds!0 -> + force + (case + ((\cse!0 -> + (\x!0 -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + x!1) + (delay + (delay + (constr 0 + [ (go!38 + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse!2))))) ]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 2 + x!1) + (delay + (delay + (constr 1 + [ ]))) + (delay + (delay + error)))))))))) + (force + (force + fstPair) + cse!1)) + (unConstrData + (force + headList + (force + tailList + (force + tailList + (force + (force + sndPair) + (unConstrData + ((\cse!0 -> + force + (force + (force + ifThenElse + (equalsInteger + 5 + (force + (force + fstPair) + cse!1)) + (delay + (delay + (force + headList + (force + tailList + (force + (force + sndPair) + cse!1))))) + (delay + (delay + error))))) + (unConstrData (force headList (force tailList (force + tailList (force - sndPair) - cse))))) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - error)))))))))) - (force - (force - fstPair) - cse)) - (unConstrData - (force - headList - (force - tailList + (force + sndPair) + (unConstrData + ds!1)))))))))))))) + [ (\cparams!0 -> + delay (force - tailList - (force - (force - sndPair) - (unConstrData - ((\cse -> - force - (force - (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - cse)) - (delay - (delay - (force - headList - (force - tailList - (force - (force - sndPair) - cse))))) - (delay - (delay - error))))) - (unConstrData - (force - headList - (force - tailList - (force - tailList - (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - (runRules - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 + (case + (fun!3 + cparams!1) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + (runRules!35 + (constr 1 [ (constr 0 - [ 1 + [ 0 , (constr 1 [ (constr 1 [ (constr 0 [ (constr 1 [ ]) , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + [ 30 + , cse!29 ]) ]) + , cse!13 ]) ]) ]) , (constr 1 [ (constr 0 - [ 2 + [ 1 , (constr 1 [ (constr 1 [ (constr 0 [ (constr 1 [ ]) , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) + [ 100000 + , cse!29 ]) ]) , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 122880 + [ 10000000 , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 3 + [ 2 , (constr 1 [ (constr 1 - [ cse + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 32768 + [ 122880 , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 4 + [ 3 , (constr 1 [ (constr 1 - [ cse + [ cse!20 , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 5000 + [ 32768 , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 5 + [ 4 , (constr 1 [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) + [ cse!20 , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 5000000 + [ 5000 , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 6 + [ 5 , (constr 1 [ (constr 1 [ (constr 0 [ (constr 1 [ ]) , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) + [ 1000000 + , cse!29 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 7 + [ 6 , (constr 1 [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse!29 ]) ]) + , cse!12 ]) ]) ]) , (constr 1 [ (constr 0 - [ 8 + [ 7 , (constr 1 [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) + [ cse!20 + , (constr 0 + [ ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 9 - , (constr 3 + [ 8 + , (constr 1 [ (constr 1 - [ cse - , cse ]) ]) ]) + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse!29 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse!10 ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 10 + [ 9 , (constr 3 [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + [ cse!7 + , cse!8 ]) ]) ]) , (constr 1 [ (constr 0 - [ 11 + [ 10 , (constr 3 [ (constr 1 - [ cse + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse!33 + 1000) + , cse!15 ]) ]) , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ (cse - 10) - , cse ]) ]) + [ (cse!33 + 200) + , (constr 0 + [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 16 - , (constr 1 + [ 11 + , (constr 3 [ (constr 1 - [ cse - , cse ]) ]) ]) + [ cse!7 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse!26 + 10) + , cse!14 ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 17 + [ 16 , (constr 1 [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 + [ cse!20 + , cse!12 ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 1 [ ]) , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) + [ 3000 + , cse!29 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse!10 ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 [ (constr 3 [ (constr 1 [ (constr 0 [ (constr 1 [ ]) , (constr 1 - [ (cse - 20000) + [ (cse!33 + 25) , (constr 0 [ ]) ]) ]) , (constr 1 @@ -425,42 +396,30 @@ [ (constr 0 [ ]) , (constr 1 - [ (cse - 5000) + [ (cse!33 + 5) , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 + , (constr 1 + [ (constr 3 + [ (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 1 [ ]) , (constr 1 - [ 40000000 + [ (cse!33 + 20000) , (constr 0 [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 15000000000 + [ (cse!33 + 5000) , (constr 0 [ ]) ]) ]) , (constr 0 @@ -469,18 +428,18 @@ [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 21 + [ 20 , (constr 2 [ (constr 1 [ (constr 1 [ (constr 1 - [ cse + [ cse!20 , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 120000000 + [ 40000000 , (constr 0 [ ]) ]) ]) , (constr 0 @@ -488,13 +447,13 @@ , (constr 1 [ (constr 1 [ (constr 1 - [ cse + [ cse!20 , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 40000000000 + [ 15000000000 , (constr 0 [ ]) ]) ]) , (constr 0 @@ -503,119 +462,129 @@ [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 22 - , (constr 1 + [ 21 + , (constr 2 [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) + [ (constr 1 + [ (constr 1 + [ cse!20 , (constr 1 - [ 12288 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) , (constr 0 - [ ]) ]) ]) + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse!20 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 23 + [ 22 , (constr 1 [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) + [ cse!20 , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 200 + [ 12288 , (constr 0 [ ]) ]) ]) - , cse ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 24 + [ 23 , (constr 1 [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse!29 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse!10 ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 25 - , (constr 2 + [ 24 + , (constr 1 [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) + [ cse!23 + , (constr 0 + [ ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 26 + [ 25 , (constr 2 [ (constr 1 - [ cse + [ cse!3 , (constr 1 - [ cse + [ cse!1 , (constr 1 - [ cse + [ cse!1 , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + [ cse!2 + , cse!4 ]) ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 27 - , (constr 1 + [ 26 + , (constr 2 [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) + [ cse!3 , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) + [ cse!1 + , (constr 1 + [ cse!1 , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + [ cse!1 + , (constr 1 + [ cse!2 + , (constr 1 + [ cse!3 + , (constr 1 + [ cse!3 + , (constr 1 + [ cse!3 + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse!17 + , cse!11 ]) ]) + , cse!5 ]) ]) + , cse!4 ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 28 + [ 27 , (constr 1 [ (constr 1 [ (constr 0 @@ -624,7 +593,7 @@ , (constr 1 [ 0 , (constr 1 - [ 18 + [ 3 , (constr 0 [ ]) ]) ]) ]) , (constr 1 @@ -632,765 +601,797 @@ [ (constr 0 [ ]) , (constr 1 - [ 293 + [ 10 , (constr 0 [ ]) ]) ]) - , cse ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 29 + [ 28 , (constr 1 [ (constr 1 - [ cse + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 15 + [ 293 , (constr 0 [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) + , cse!10 ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 30 + [ 29 , (constr 1 [ (constr 1 - [ cse + [ cse!23 , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 10000000000000 + [ 15 , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 31 + [ 30 , (constr 1 [ (constr 1 - [ cse + [ cse!9 , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 100000000000 + [ 10000000000000 , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 32 + [ 31 , (constr 1 [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) + [ cse!9 , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ 37 + [ 100000000000 , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) , (constr 1 [ (constr 0 - [ 33 - , (constr 3 + [ 32 + , (constr 1 [ (constr 1 [ (constr 0 [ (constr 1 [ ]) - , cse ]) + , (constr 1 + [ 13 + , cse!29 ]) ]) , (constr 1 [ (constr 0 [ (constr 0 [ ]) , (constr 1 - [ (unsafeRatio - 1000 - 1) + [ 37 , (constr 0 [ ]) ]) ]) , (constr 0 [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 + , (constr 1 + [ (constr 0 + [ 33 + , (constr 1 + [ (constr 1 + [ cse!20 + , cse!13 ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) + (constr 3 + [ (constr 1 [ (constr 0 - [ (constr 0 + [ (constr 1 [ ]) , (constr 1 - [ cse + [ cse!16 , (constr 1 - [ cse + [ cse!17 , (constr 0 [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) + , cse!4 ]) ])) + (constr 3 + [ (constr 1 + [ cse!4 , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ])) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse!22 + , (constr 1 + [ cse!19 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse!3 + , (constr 1 [ (constr 0 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse!21 + , cse!8 ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse!13 + , (constr 0 + [ ]) ]) ]) + , cse!4 ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 [ (constr 0 - [ ]) - , (constr 1 - [ cse + [ (constr 0 + [ ]) , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse + [ cse!19 + , (constr 1 + [ cse!11 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ])) - (constr 1 - [ (constr 0 + [ cse!11 + , (constr 1 + [ cse!13 + , (constr 0 + [ ]) ]) ]) ])) + (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse!26 + 10) + , cse!8 ]) ])) + (constr 1 [ (constr 0 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 + [ (constr 0 + [ ]) + , cse!6 ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 + [ ]) , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ (cse - 4) - , (constr 0 - [ ]) ])) - (constr 1 - [ (constr 0 + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) + (constr 1 + [ (constr 0 + [ (constr 2 + [ ]) + , cse!19 ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ cse!14 + , (constr 0 + [ ]) ])) + (constr 1 [ (constr 0 - [ ]) - , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) - (cse - 100)) - (cse - 20)) - (cse - 10)) - (cse - 1)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 2)) - (cse 1)) - (cse 5)) - (unsafeRatio 0)) - (unsafeRatio 3)) - (unsafeRatio 13)) - (unsafeRatio 9)) - (unsafeRatio 1)) - (unsafeRatio 51)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 4)) - (fix1 - (\go l -> - force (force chooseList) - l - (\ds -> constr 0 []) - (\ds -> - constr 1 - [ ((\p -> - constr 0 - [ (force - (force fstPair) - p) - , (force - (force sndPair) - p) ]) - (force headList l)) - , (go (force tailList l)) ]) - ()))) - (fix1 - (\runRules ds cparams -> - force - ((\fail -> - case - ds - [ (delay (fail ())) - , (\ds cfgRest -> - delay - (case - ds - [ (\expectedPid - paramValue -> - force - (case - cparams - [ (delay - (fail - ())) - , (\ds - cparamsRest -> - delay - (case - ds - [ (\ds - actualValueData -> - force - (case - (`$fOrdInteger_$ccompare` - (unIData - ds) - expectedPid) - [ (delay - (force - (case - (validateParamValue - paramValue - actualValueData) - [ (delay - (runRules - cfgRest - cparamsRest)) - , (delay - (constr 1 - [ ])) ]))) - , (delay - (runRules - cfgRest - cparams)) - , (delay - (constr 1 - [ ])) ])) ])) ])) ])) ]) - (\ds -> - force - (case - cparams - [ (delay (constr 0 [])) - , (\ipv ipv -> - delay - (constr 1 - [])) ])))))) - (cse (\arg_0 arg_1 -> arg_1))) - (cse (\arg_0 arg_1 -> arg_0))) - (force - ((\s -> s s) - (\s h -> - delay - (\fr -> - (\k -> - fr - (\x -> k (\f_0 f_1 -> f_0 x)) - (\x -> k (\f_0 f_1 -> f_1 x))) - (\fq -> force (s s h) (force h fq)))) - (delay - (\choose - validateParamValue - validateParamValues -> - choose - (\eta eta -> - force - (case - eta - [ (delay (constr 0 [])) - , (\preds -> - delay - (validatePreds - (constr 0 - [ (\x y -> - force ifThenElse - (equalsInteger - x - y) - (constr 0 []) - (constr 1 [])) - , `$fOrdInteger_$ccompare` - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - (constr 0 []) - (constr 1 [])) - , (\x y -> - force ifThenElse - (lessThanEqualsInteger - x - y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force ifThenElse - (lessThanInteger - x - y) - (constr 1 []) - (constr 0 [])) - , (\x y -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - y)) - (delay - (delay - x))))) - , (\x y -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - x)) - (delay - (delay - y))))) ]) - preds - (unIData eta))) - , (\paramValues -> - delay - (validateParamValues - paramValues - (unListData eta))) - , (\preds -> - delay - ((\cse -> - validatePreds - (constr 0 - [ (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - (force - (force - ifThenElse - (equalsInteger - n - n') - (delay - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 1 - [ ])))) - (delay - (delay + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ])) (constr 1 - [ ])))))) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - `$fOrdInteger_$ccompare` - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) - , `$fOrdRational0_$c<=` - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanEqualsInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' - d' -> + [ cse!10 + , (constr 0 + [ ]) ])) + (constr 1 + [ cse!7 + , (constr 0 + [ ]) ])) + (cse!12 + 10)) + (cse!16 + 2)) + (cse!9 + 20)) + (cse!13 + 100)) + (constr 0 + [ (constr 1 + [ ]) + , cse!9 ])) + (cse!10 + 5)) + (cse!8 + 1)) + (constr 0 + [ (constr 1 + []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse!9 1)) + (cse!1 4)) + (unsafeRatio!13 3)) + (unsafeRatio!12 13)) + (unsafeRatio!11 9)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio!9 0)) + (unsafeRatio!8 4)) + (unsafeRatio!7 51)) + (unsafeRatio!6 1)) + (fix1!10 + (\go!0 l!0 -> + force (force chooseList) + l!1 + (\ds!0 -> constr 0 []) + (\ds!0 -> + constr 1 + [ ((\p!0 -> + constr 0 + [ (force (force fstPair) + p!1) + , (force (force sndPair) + p!1) ]) + (force headList l!2)) + , (go!3 (force tailList l!2)) ]) + ()))) + (fix1!9 + (\runRules!0 ds!0 cparams!0 -> + force + ((\fail!0 -> + case + ds!3 + [ (delay (fail!1 ())) + , (\ds!0 cfgRest!0 -> + delay + (case + ds!2 + [ (\expectedPid!0 + paramValue!0 -> + force + (case + cparams!6 + [ (delay + (fail!5 + ())) + , (\ds!0 + cparamsRest!0 -> + delay + (case + ds!2 + [ (\ds!0 + actualValueData!0 -> force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay - y) - , (delay - x) ])) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay - x) - , (delay - y) ])) ]) - preds - ((\cse -> + (case + (`$fOrdInteger_$ccompare`!19 + (unIData + ds!2) + expectedPid!6) + [ (delay + (force + (case + (validateParamValue!14 + paramValue!5 + actualValueData!1) + [ (delay + (runRules!12 + cfgRest!7 + cparamsRest!3)) + , (delay + (constr 1 + [ ])) ]))) + , (delay + (runRules!12 + cfgRest!7 + cparams!10)) + , (delay + (constr 1 + [ ])) ])) ])) ])) ])) ]) + (\ds!0 -> + force + (case + cparams!2 + [ (delay (constr 0 [])) + , (\ipv!0 ipv!0 -> + delay + (constr 1 [])) ])))))) + (cse!2 (\arg_0!0 arg_1!0 -> arg_1!1))) + (cse!1 (\arg_0!0 arg_1!0 -> arg_0!2))) + (force + ((\s!0 -> s!1 s!1) + (\s!0 h!0 -> + delay + (\fr!0 -> + (\k!0 -> + fr!2 + (\x!0 -> + k!2 (\f_0!0 f_1!0 -> f_0!2 x!3)) + (\x!0 -> + k!2 (\f_0!0 f_1!0 -> f_1!1 x!3))) + (\fq!0 -> + force (s!4 s!4 h!3) + (force h!3 fq!1)))) + (delay + (\choose!0 + validateParamValue!0 + validateParamValues!0 -> + choose!3 + (\eta!0 eta!0 -> + force + (case + eta!2 + [ (delay (constr 0 [])) + , (\preds!0 -> + delay + (validatePreds!9 + (constr 0 + [ (\x!0 y!0 -> + force ifThenElse + (equalsInteger + x!2 + y!1) + (constr 0 []) + (constr 1 [])) + , `$fOrdInteger_$ccompare`!10 + , (\x!0 y!0 -> + force ifThenElse + (lessThanInteger + x!2 + y!1) + (constr 0 []) + (constr 1 [])) + , (\x!0 y!0 -> + force ifThenElse + (lessThanEqualsInteger + x!2 + y!1) + (constr 0 []) + (constr 1 [])) + , (\x!0 y!0 -> + force ifThenElse + (lessThanEqualsInteger + x!2 + y!1) + (constr 1 []) + (constr 0 [])) + , (\x!0 y!0 -> force ifThenElse - (force nullList + (lessThanInteger + x!2 + y!1) + (constr 1 []) + (constr 0 [])) + , (\x!0 y!0 -> + force + (force (force - tailList - cse)) - (\ds -> - unsafeRatio - (unIData - (force - headList - cse)) - (unIData - (force - headList - cse)))) - (force tailList - cse) - (\ds -> error) - (constr 0 []))) - (unListData eta))) ])) - (\ds -> - case - ds - [ (\eta -> - force ifThenElse - (force nullList eta) - (constr 0 []) - (constr 1 [])) - , (\paramValueHd - paramValueTl - actualValueData -> - force - (case - (validateParamValue - paramValueHd - (force headList - actualValueData)) - [ (delay - (validateParamValues - paramValueTl + ifThenElse + (lessThanEqualsInteger + x!2 + y!1) + (delay + (delay + y!1)) + (delay + (delay + x!2))))) + , (\x!0 y!0 -> + force + (force + (force + ifThenElse + (lessThanEqualsInteger + x!2 + y!1) + (delay + (delay + x!2)) + (delay + (delay + y!1))))) ]) + preds!1 + (unIData eta!2))) + , (\paramValues!0 -> + delay + (validateParamValues!4 + paramValues!1 + (unListData eta!2))) + , (\preds!0 -> + delay + ((\cse!0 -> + validatePreds!10 + (constr 0 + [ (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + force + (force + (force + ifThenElse + (equalsInteger + n!4 + n'!2) + (delay + (delay + (force + ifThenElse + (equalsInteger + d!3 + d'!1) + (constr 0 + [ ]) + (constr 1 + [ ])))) + (delay + (delay + (constr 1 + [ ])))))) ]) ]) + , (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + `$fOrdInteger_$ccompare`!17 + (multiplyInteger + n!4 + d'!1) + (multiplyInteger + n'!2 + d!3)) ]) ]) + , (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n!4 + d'!1) + (multiplyInteger + n'!2 + d!3)) + (constr 0 + [ ]) + (constr 1 + [ ])) ]) ]) + , `$fOrdRational0_$c<=`!12 + , (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + force + ifThenElse + (lessThanEqualsInteger + (multiplyInteger + n!4 + d'!1) + (multiplyInteger + n'!2 + d!3)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n!4 + d'!1) + (multiplyInteger + n'!2 + d!3)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\x!0 y!0 -> + force + (case + (`$fOrdRational0_$c<=`!14 + x!2 + y!1) + [ (delay + y!1) + , (delay + x!2) ])) + , (\x!0 y!0 -> + force + (case + (`$fOrdRational0_$c<=`!14 + x!2 + y!1) + [ (delay + x!2) + , (delay + y!1) ])) ]) + preds!2 + ((\cse!0 -> + force ifThenElse + (force nullList + (force + tailList + cse!1)) + (\ds!0 -> + unsafeRatio!10 + (unIData + (force + headList + cse!3)) + (unIData + (force + headList + cse!2)))) (force tailList - actualValueData))) - , (delay - (constr 1 - [])) ])) ])))))) - (fix1 - (\unsafeRatio n d -> - force - (force - (force ifThenElse - (equalsInteger 0 d) - (delay (delay error)) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - (delay - (unsafeRatio - (subtractInteger 0 n) - (subtractInteger - 0 - d)))) - (delay - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger - n - gcd') - , (quotientInteger - d - gcd') ]) - (euclid - n - d)))))))))))))) - (fix1 - (\euclid x y -> - force - (force - (force ifThenElse - (equalsInteger 0 y) - (delay (delay x)) - (delay (delay (euclid y (modInteger x y))))))))) - (\`$dOrd` ds ds -> - fix1 - (\go ds -> + cse!1) + (\ds!0 -> error) + (constr 0 []))) + (unListData eta!2))) ])) + (\ds!0 -> + case + ds!1 + [ (\eta!0 -> + force ifThenElse + (force nullList eta!1) + (constr 0 []) + (constr 1 [])) + , (\paramValueHd!0 + paramValueTl!0 + actualValueData!0 -> + force + (case + (validateParamValue!6 + paramValueHd!3 + (force headList + actualValueData!1)) + [ (delay + (validateParamValues!5 + paramValueTl!2 + (force tailList + actualValueData!1))) + , (delay + (constr 1 + [])) ])) ])))))) + (fix1!5 + (\unsafeRatio!0 n!0 d!0 -> + force + (force + (force ifThenElse + (equalsInteger 0 d!1) + (delay (delay error)) + (delay + (delay + (force + (force + (force ifThenElse + (lessThanInteger d!1 0) + (delay + (delay + (unsafeRatio!3 + (subtractInteger + 0 + n!2) + (subtractInteger + 0 + d!1)))) + (delay + (delay + ((\gcd'!0 -> + constr 0 + [ (quotientInteger + n!3 + gcd'!1) + , (quotientInteger + d!2 + gcd'!1) ]) + (euclid!4 + n!2 + d!1)))))))))))))) + (fix1!4 + (\euclid!0 x!0 y!0 -> force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (case - x - [ (\predKey expectedPredValues -> - (\meaning -> - fix1 - (\go ds -> - force - (case - ds - [ (delay (go xs)) - , (\x xs -> - delay - (force - (case - (meaning - x - ds) - [ (delay - (go - xs)) - , (delay - (constr 1 - [ ])) ]))) ])) - expectedPredValues) - (force - (case - predKey - [ (delay - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ])) - , (delay - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ])) - , (delay - (\x y -> - force - (case - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ] - x - y) - [ (delay - (constr 1 - [])) - , (delay - (constr 0 - [ ])) ]))) ]))) ])) ])) - ds)) - (\eta eta -> - force - (force - (force ifThenElse - (equalsInteger eta eta) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger eta eta) - (delay (delay (constr 2 []))) - (delay (delay (constr 1 [])))))))))))) - (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' d' -> - force ifThenElse - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) - (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file + (force + (force ifThenElse + (equalsInteger 0 y!1) + (delay (delay x!2)) + (delay + (delay + (euclid!3 y!1 (modInteger x!2 y!1))))))))) + (\`$dOrd`!0 ds!0 ds!0 -> + fix1!6 + (\go!0 ds!0 -> + force + (case + ds!1 + [ (delay (constr 0 [])) + , (\x!0 xs!0 -> + delay + (case + x!2 + [ (\predKey!0 expectedPredValues!0 -> + (\meaning!0 -> + fix1!13 + (\go!0 ds!0 -> + force + (case + ds!1 + [ (delay (go!9 xs!6)) + , (\x!0 xs!0 -> + delay + (force + (case + (meaning!5 + x!2 + ds!12) + [ (delay + (go!4 + xs!1)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues!2) + (force + (case + predKey!2 + [ (delay + (case + `$dOrd`!9 + [ (\v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 -> + v!3) ])) + , (delay + (case + `$dOrd`!9 + [ (\v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 -> + v!5) ])) + , (delay + (\x!0 y!0 -> + force + (case + (case + `$dOrd`!11 + [ (\v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 -> + v!8) ] + x!2 + y!1) + [ (delay + (constr 1 + [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds!2)) + (\eta!0 eta!0 -> + force + (force + (force ifThenElse + (equalsInteger eta!2 eta!1) + (delay (delay (constr 0 []))) + (delay + (delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger eta!2 eta!1) + (delay (delay (constr 2 []))) + (delay (delay (constr 1 [])))))))))))) + (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 d!0 -> + case + ds!3 + [ (\n'!0 d'!0 -> + force ifThenElse + (lessThanEqualsInteger + (multiplyInteger n!4 d'!1) + (multiplyInteger n'!2 d!3)) + (constr 0 []) + (constr 1 [])) ]) ])) + (\f!0 -> (\s!0 -> s!1 s!1) (\s!0 -> f!2 (\x!0 -> s!2 s!2 x!1)))) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden index e3a7f1ded40..ecb474cd53e 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.pir.golden @@ -1,5302 +1,5750 @@ -(program - 1.1.0 - (let - data Ordering | Ordering_match where - EQ : Ordering - GT : Ordering - LT : Ordering - data Bool | Bool_match where - True : Bool - False : Bool - data (Ord :: * -> *) a | Ord_match where - CConsOrd : - (\a -> a -> a -> Bool) a -> - (a -> a -> Ordering) -> - (a -> a -> Bool) -> - (a -> a -> Bool) -> - (a -> a -> Bool) -> - (a -> a -> Bool) -> - (a -> a -> a) -> - (a -> a -> a) -> - Ord a - data PredKey | PredKey_match where - MaxValue : PredKey - MinValue : PredKey - NotEqual : PredKey - data (Tuple2 :: * -> * -> *) a b | Tuple2_match where - Tuple2 : a -> b -> Tuple2 a b - in - letrec - data (List :: * -> *) a | List_match where - Nil : List a - Cons : a -> List a -> List a - in - let - !validatePreds : - all a. Ord a -> (\v -> List (Tuple2 PredKey (List v))) a -> a -> Bool - = /\a -> - \(`$dOrd` : Ord a) - (ds : (\v -> List (Tuple2 PredKey (List v))) a) - (ds : a) -> - letrec - !go : List (Tuple2 PredKey (List a)) -> Bool - = \(ds : List (Tuple2 PredKey (List a))) -> - List_match - {Tuple2 PredKey (List a)} - ds - {all dead. Bool} - (/\dead -> True) - (\(x : Tuple2 PredKey (List a)) - (xs : List (Tuple2 PredKey (List a))) -> - /\dead -> - Tuple2_match - {PredKey} - {List a} - x - {Bool} - (\(predKey : PredKey) - (expectedPredValues : List a) -> - let - !meaning : a -> a -> Bool - = PredKey_match - predKey - {all dead. a -> a -> Bool} - (/\dead -> - Ord_match - {a} - `$dOrd` - {a -> a -> Bool} - (\(v : (\a -> a -> a -> Bool) a) - (v : a -> a -> Ordering) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> a) - (v : a -> a -> a) -> - v)) - (/\dead -> - Ord_match - {a} - `$dOrd` - {a -> a -> Bool} - (\(v : (\a -> a -> a -> Bool) a) - (v : a -> a -> Ordering) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> a) - (v : a -> a -> a) -> - v)) - (/\dead -> - \(x : a) (y : a) -> - Bool_match - (Ord_match - {a} - `$dOrd` - {(\a -> a -> a -> Bool) a} - (\(v : - (\a -> a -> a -> Bool) - a) - (v : a -> a -> Ordering) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> Bool) - (v : a -> a -> a) - (v : a -> a -> a) -> - v) - x - y) - {all dead. Bool} - (/\dead -> False) - (/\dead -> True) - {all dead. dead}) - {all dead. dead} - in - letrec - !go : List a -> Bool - = \(ds : List a) -> - List_match - {a} - ds - {all dead. Bool} - (/\dead -> go xs) - (\(x : a) (xs : List a) -> - /\dead -> - Bool_match - (meaning x ds) - {all dead. Bool} - (/\dead -> go xs) - (/\dead -> False) - {all dead. dead}) - {all dead. dead} - in - go expectedPredValues)) - {all dead. dead} - in - go ds - !equalsInteger : integer -> integer -> Bool - = \(x : integer) (y : integer) -> - ifThenElse {Bool} (equalsInteger x y) True False - !`$fOrdInteger_$ccompare` : integer -> integer -> Ordering - = \(eta : integer) (eta : integer) -> - Bool_match - (ifThenElse {Bool} (equalsInteger eta eta) True False) - {all dead. Ordering} - (/\dead -> EQ) - (/\dead -> - Bool_match - (ifThenElse {Bool} (lessThanEqualsInteger eta eta) True False) - {all dead. Ordering} - (/\dead -> LT) - (/\dead -> GT) - {all dead. dead}) - {all dead. dead} - data Rational | Rational_match where - Rational : integer -> integer -> Rational - !`$fOrdRational0_$c<=` : Rational -> Rational -> Bool - = \(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - True - False)) - in - letrec - !euclid : integer -> integer -> integer - = \(x : integer) (y : integer) -> - Bool_match - (ifThenElse {Bool} (equalsInteger 0 y) True False) - {all dead. integer} - (/\dead -> x) - (/\dead -> euclid y (modInteger x y)) - {all dead. dead} - in - letrec - !unsafeRatio : integer -> integer -> Rational - = \(n : integer) (d : integer) -> - Bool_match - (ifThenElse {Bool} (equalsInteger 0 d) True False) - {all dead. Rational} - (/\dead -> error {Rational}) - (/\dead -> - Bool_match - (ifThenElse {Bool} (lessThanInteger d 0) True False) - {all dead. Rational} - (/\dead -> - unsafeRatio (subtractInteger 0 n) (subtractInteger 0 d)) - (/\dead -> - let - !gcd' : integer = euclid n d - in - Rational (quotientInteger n gcd') (quotientInteger d gcd')) - {all dead. dead}) - {all dead. dead} - in - letrec - data ParamValue | ParamValue_match where - ParamAny : ParamValue - ParamInteger : - (\v -> List (Tuple2 PredKey (List v))) integer -> ParamValue - ParamList : List ParamValue -> ParamValue - ParamRational : - (\v -> List (Tuple2 PredKey (List v))) Rational -> ParamValue - in - let - data Unit | Unit_match where - Unit : Unit - in - letrec - !validateParamValue : ParamValue -> data -> Bool - = \(eta : ParamValue) (eta : data) -> - let - ~bl : list data = unListData eta - ~bl' : list data = tailList {data} bl - in - ParamValue_match - eta - {all dead. Bool} - (/\dead -> True) - (\(preds : (\v -> List (Tuple2 PredKey (List v))) integer) -> - /\dead -> - validatePreds +program + 1.1.0 + (let + data Ordering-71617 | Ordering_match-71621 where + EQ-71618 : Ordering-71617 + GT-71619 : Ordering-71617 + LT-71620 : Ordering-71617 + data Bool-71608 | Bool_match-71611 where + True-71609 : Bool-71608 + False-71610 : Bool-71608 + data (Ord-71622 :: * -> *) a-71625 | Ord_match-71624 where + CConsOrd-71623 : + (\a-71626 -> a-71626 -> a-71626 -> Bool-71608) a-71625 -> + (a-71625 -> a-71625 -> Ordering-71617) -> + (a-71625 -> a-71625 -> Bool-71608) -> + (a-71625 -> a-71625 -> Bool-71608) -> + (a-71625 -> a-71625 -> Bool-71608) -> + (a-71625 -> a-71625 -> Bool-71608) -> + (a-71625 -> a-71625 -> a-71625) -> + (a-71625 -> a-71625 -> a-71625) -> + Ord-71622 a-71625 + data PredKey-71612 | PredKey_match-71616 where + MaxValue-71613 : PredKey-71612 + MinValue-71614 : PredKey-71612 + NotEqual-71615 : PredKey-71612 + data (Tuple2-71593 :: * -> * -> *) a-71596 + b-71597 | Tuple2_match-71595 where + Tuple2-71594 : a-71596 -> b-71597 -> Tuple2-71593 a-71596 b-71597 + in + letrec + data (List-71588 :: * -> *) a-71592 | List_match-71591 where + Nil-71589 : List-71588 a-71592 + Cons-71590 : a-71592 -> List-71588 a-71592 -> List-71588 a-71592 + in + let + !validatePreds-71758 : + all a-71759. + Ord-71622 a-71759 -> + (\v-71760 -> + List-71588 (Tuple2-71593 PredKey-71612 (List-71588 v-71760))) + a-71759 -> + a-71759 -> + Bool-71608 + = /\a-71691 -> + \(`$dOrd`-71692 : Ord-71622 a-71691) + (ds-71693 : + (\v-71694 -> + List-71588 (Tuple2-71593 PredKey-71612 (List-71588 v-71694))) + a-71691) + (ds-71695 : a-71691) -> + letrec + !go-71696 : + List-71588 (Tuple2-71593 PredKey-71612 (List-71588 a-71691)) -> + Bool-71608 + = \(ds-71697 : + List-71588 + (Tuple2-71593 PredKey-71612 (List-71588 a-71691))) -> + List_match-71591 + {Tuple2-71593 PredKey-71612 (List-71588 a-71691)} + ds-71697 + {all dead-71698. Bool-71608} + (/\dead-71699 -> True-71609) + (\(x-71700 : + Tuple2-71593 PredKey-71612 (List-71588 a-71691)) + (xs-71701 : + List-71588 + (Tuple2-71593 + PredKey-71612 + (List-71588 a-71691))) -> + /\dead-71702 -> + Tuple2_match-71595 + {PredKey-71612} + {List-71588 a-71691} + x-71700 + {Bool-71608} + (\(predKey-71703 : PredKey-71612) + (expectedPredValues-71704 : + List-71588 a-71691) -> + let + !meaning-71744 : + a-71691 -> a-71691 -> Bool-71608 + = PredKey_match-71616 + predKey-71703 + {all dead-71705. + a-71691 -> a-71691 -> Bool-71608} + (/\dead-71706 -> + Ord_match-71624 + {a-71691} + `$dOrd`-71692 + {a-71691 -> a-71691 -> Bool-71608} + (\(v-71707 : + (\a-71708 -> + a-71708 -> + a-71708 -> + Bool-71608) + a-71691) + (v-71709 : + a-71691 -> + a-71691 -> + Ordering-71617) + (v-71710 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71711 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71712 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71713 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71714 : + a-71691 -> a-71691 -> a-71691) + (v-71715 : + a-71691 -> + a-71691 -> + a-71691) -> + v-71713)) + (/\dead-71716 -> + Ord_match-71624 + {a-71691} + `$dOrd`-71692 + {a-71691 -> a-71691 -> Bool-71608} + (\(v-71717 : + (\a-71718 -> + a-71718 -> + a-71718 -> + Bool-71608) + a-71691) + (v-71719 : + a-71691 -> + a-71691 -> + Ordering-71617) + (v-71720 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71721 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71722 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71723 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71724 : + a-71691 -> a-71691 -> a-71691) + (v-71725 : + a-71691 -> + a-71691 -> + a-71691) -> + v-71721)) + (/\dead-71726 -> + \(x-71727 : a-71691) + (y-71728 : a-71691) -> + Bool_match-71611 + (Ord_match-71624 + {a-71691} + `$dOrd`-71692 + {(\a-71729 -> + a-71729 -> + a-71729 -> + Bool-71608) + a-71691} + (\(v-71730 : + (\a-71731 -> + a-71731 -> + a-71731 -> + Bool-71608) + a-71691) + (v-71732 : + a-71691 -> + a-71691 -> + Ordering-71617) + (v-71733 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71734 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71735 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71736 : + a-71691 -> + a-71691 -> + Bool-71608) + (v-71737 : + a-71691 -> + a-71691 -> + a-71691) + (v-71738 : + a-71691 -> + a-71691 -> + a-71691) -> + v-71730) + x-71727 + y-71728) + {all dead-71739. Bool-71608} + (/\dead-71740 -> False-71610) + (/\dead-71741 -> True-71609) + {all dead-71742. dead-71742}) + {all dead-71743. dead-71743} + in + letrec + !go-71745 : List-71588 a-71691 -> Bool-71608 + = \(ds-71746 : List-71588 a-71691) -> + List_match-71591 + {a-71691} + ds-71746 + {all dead-71747. Bool-71608} + (/\dead-71748 -> go-71696 xs-71701) + (\(x-71749 : a-71691) + (xs-71750 : List-71588 a-71691) -> + /\dead-71751 -> + Bool_match-71611 + (meaning-71744 + x-71749 + ds-71695) + {all dead-71752. Bool-71608} + (/\dead-71753 -> + go-71745 xs-71750) + (/\dead-71754 -> False-71610) + {all dead-71755. dead-71755}) + {all dead-71756. dead-71756} + in + go-71745 expectedPredValues-71704)) + {all dead-71757. dead-71757} + in + go-71696 ds-71693 + !`$fOrdInteger_$ccompare`-71677 : integer -> integer -> Ordering-71617 + = \(eta-71667 : integer) (eta-71668 : integer) -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (equalsInteger eta-71667 eta-71668) + True-71609 + False-71610) + {all dead-71669. Ordering-71617} + (/\dead-71670 -> EQ-71618) + (/\dead-71671 -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (lessThanEqualsInteger eta-71667 eta-71668) + True-71609 + False-71610) + {all dead-71672. Ordering-71617} + (/\dead-71673 -> LT-71620) + (/\dead-71674 -> GT-71619) + {all dead-71675. dead-71675}) + {all dead-71676. dead-71676} + data Rational-71627 | Rational_match-71629 where + Rational-71628 : integer -> integer -> Rational-71627 + !`$fOrdRational0_$c<=`-71666 : + Rational-71627 -> Rational-71627 -> Bool-71608 + = \(ds-71660 : Rational-71627) (ds-71661 : Rational-71627) -> + Rational_match-71629 + ds-71660 + {Bool-71608} + (\(n-71662 : integer) (d-71663 : integer) -> + Rational_match-71629 + ds-71661 + {Bool-71608} + (\(n'-71664 : integer) (d'-71665 : integer) -> + ifThenElse + {Bool-71608} + (lessThanEqualsInteger + (multiplyInteger n-71662 d'-71665) + (multiplyInteger n'-71664 d-71663)) + True-71609 + False-71610)) + in + letrec + !euclid-71641 : integer -> integer -> integer + = \(x-71642 : integer) (y-71643 : integer) -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (equalsInteger 0 y-71643) + True-71609 + False-71610) + {all dead-71644. integer} + (/\dead-71645 -> x-71642) + (/\dead-71646 -> euclid-71641 y-71643 (modInteger x-71642 y-71643)) + {all dead-71647. dead-71647} + in + letrec + !unsafeRatio-71648 : integer -> integer -> Rational-71627 + = \(n-71649 : integer) (d-71650 : integer) -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (equalsInteger 0 d-71650) + True-71609 + False-71610) + {all dead-71651. Rational-71627} + (/\dead-71652 -> error {Rational-71627}) + (/\dead-71653 -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (lessThanInteger d-71650 0) + True-71609 + False-71610) + {all dead-71654. Rational-71627} + (/\dead-71655 -> + unsafeRatio-71648 + (subtractInteger 0 n-71649) + (subtractInteger 0 d-71650)) + (/\dead-71656 -> + let + !gcd'-71657 : integer = euclid-71641 n-71649 d-71650 + in + Rational-71628 + (quotientInteger n-71649 gcd'-71657) + (quotientInteger d-71650 gcd'-71657)) + {all dead-71658. dead-71658}) + {all dead-71659. dead-71659} + in + let + data Unit-71638 | Unit_match-71640 where + Unit-71639 : Unit-71638 + in + letrec + data ParamValue-71630 | ParamValue_match-71635 where + ParamAny-71631 : ParamValue-71630 + ParamInteger-71632 : + (\v-71636 -> + List-71588 (Tuple2-71593 PredKey-71612 (List-71588 v-71636))) + integer -> + ParamValue-71630 + ParamList-71633 : List-71588 ParamValue-71630 -> ParamValue-71630 + ParamRational-71634 : + (\v-71637 -> + List-71588 (Tuple2-71593 PredKey-71612 (List-71588 v-71637))) + Rational-71627 -> + ParamValue-71630 + in + letrec + !validateParamValue-71678 : ParamValue-71630 -> data -> Bool-71608 + = \(eta-71679 : ParamValue-71630) (eta-71680 : data) -> + let + ~bl-71839 : list data = unListData eta-71680 + ~bl'-71840 : list data = tailList {data} bl-71839 + in + ParamValue_match-71635 + eta-71679 + {all dead-71761. Bool-71608} + (/\dead-71762 -> True-71609) + (\(preds-71763 : + (\v-71764 -> + List-71588 + (Tuple2-71593 PredKey-71612 (List-71588 v-71764))) + integer) -> + /\dead-71765 -> + validatePreds-71758 + {integer} + (CConsOrd-71623 + {integer} + (\(x-71766 : integer) (y-71767 : integer) -> + ifThenElse + {Bool-71608} + (equalsInteger x-71766 y-71767) + True-71609 + False-71610) + `$fOrdInteger_$ccompare`-71677 + (\(x-71768 : integer) (y-71769 : integer) -> + ifThenElse + {Bool-71608} + (lessThanInteger x-71768 y-71769) + True-71609 + False-71610) + (\(x-71770 : integer) (y-71771 : integer) -> + ifThenElse + {Bool-71608} + (lessThanEqualsInteger x-71770 y-71771) + True-71609 + False-71610) + (\(x-71772 : integer) (y-71773 : integer) -> + ifThenElse + {Bool-71608} + (lessThanEqualsInteger x-71772 y-71773) + False-71610 + True-71609) + (\(x-71774 : integer) (y-71775 : integer) -> + ifThenElse + {Bool-71608} + (lessThanInteger x-71774 y-71775) + False-71610 + True-71609) + (\(x-71776 : integer) (y-71777 : integer) -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (lessThanEqualsInteger x-71776 y-71777) + True-71609 + False-71610) + {all dead-71778. integer} + (/\dead-71779 -> y-71777) + (/\dead-71780 -> x-71776) + {all dead-71781. dead-71781}) + (\(x-71782 : integer) (y-71783 : integer) -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (lessThanEqualsInteger x-71782 y-71783) + True-71609 + False-71610) + {all dead-71784. integer} + (/\dead-71785 -> x-71782) + (/\dead-71786 -> y-71783) + {all dead-71787. dead-71787})) + preds-71763 + (unIData eta-71680)) + (\(paramValues-71788 : List-71588 ParamValue-71630) -> + /\dead-71789 -> + validateParamValues-71681 + paramValues-71788 + (unListData eta-71680)) + (\(preds-71790 : + (\v-71791 -> + List-71588 + (Tuple2-71593 PredKey-71612 (List-71588 v-71791))) + Rational-71627) -> + /\dead-71792 -> + validatePreds-71758 + {Rational-71627} + (CConsOrd-71623 + {Rational-71627} + (\(ds-71793 : Rational-71627) + (ds-71794 : Rational-71627) -> + Rational_match-71629 + ds-71793 + {Bool-71608} + (\(n-71795 : integer) (d-71796 : integer) -> + Rational_match-71629 + ds-71794 + {Bool-71608} + (\(n'-71797 : integer) (d'-71798 : integer) -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (equalsInteger n-71795 n'-71797) + True-71609 + False-71610) + {all dead-71799. Bool-71608} + (/\dead-71800 -> + ifThenElse + {Bool-71608} + (equalsInteger d-71796 d'-71798) + True-71609 + False-71610) + (/\dead-71801 -> False-71610) + {all dead-71802. dead-71802}))) + (\(ds-71803 : Rational-71627) + (ds-71804 : Rational-71627) -> + Rational_match-71629 + ds-71803 + {Ordering-71617} + (\(n-71805 : integer) (d-71806 : integer) -> + Rational_match-71629 + ds-71804 + {Ordering-71617} + (\(n'-71807 : integer) (d'-71808 : integer) -> + `$fOrdInteger_$ccompare`-71677 + (multiplyInteger n-71805 d'-71808) + (multiplyInteger n'-71807 d-71806)))) + (\(ds-71809 : Rational-71627) + (ds-71810 : Rational-71627) -> + Rational_match-71629 + ds-71809 + {Bool-71608} + (\(n-71811 : integer) (d-71812 : integer) -> + Rational_match-71629 + ds-71810 + {Bool-71608} + (\(n'-71813 : integer) (d'-71814 : integer) -> + ifThenElse + {Bool-71608} + (lessThanInteger + (multiplyInteger n-71811 d'-71814) + (multiplyInteger n'-71813 d-71812)) + True-71609 + False-71610))) + `$fOrdRational0_$c<=`-71666 + (\(ds-71815 : Rational-71627) + (ds-71816 : Rational-71627) -> + Rational_match-71629 + ds-71815 + {Bool-71608} + (\(n-71817 : integer) (d-71818 : integer) -> + Rational_match-71629 + ds-71816 + {Bool-71608} + (\(n'-71819 : integer) (d'-71820 : integer) -> + ifThenElse + {Bool-71608} + (lessThanEqualsInteger + (multiplyInteger n-71817 d'-71820) + (multiplyInteger n'-71819 d-71818)) + False-71610 + True-71609))) + (\(ds-71821 : Rational-71627) + (ds-71822 : Rational-71627) -> + Rational_match-71629 + ds-71821 + {Bool-71608} + (\(n-71823 : integer) (d-71824 : integer) -> + Rational_match-71629 + ds-71822 + {Bool-71608} + (\(n'-71825 : integer) (d'-71826 : integer) -> + ifThenElse + {Bool-71608} + (lessThanInteger + (multiplyInteger n-71823 d'-71826) + (multiplyInteger n'-71825 d-71824)) + False-71610 + True-71609))) + (\(x-71827 : Rational-71627) (y-71828 : Rational-71627) -> + Bool_match-71611 + (`$fOrdRational0_$c<=`-71666 x-71827 y-71828) + {all dead-71829. Rational-71627} + (/\dead-71830 -> y-71828) + (/\dead-71831 -> x-71827) + {all dead-71832. dead-71832}) + (\(x-71833 : Rational-71627) (y-71834 : Rational-71627) -> + Bool_match-71611 + (`$fOrdRational0_$c<=`-71666 x-71833 y-71834) + {all dead-71835. Rational-71627} + (/\dead-71836 -> x-71833) + (/\dead-71837 -> y-71834) + {all dead-71838. dead-71838})) + preds-71790 + (ifThenElse + {Unit-71638 -> Rational-71627} + (nullList {data} (tailList {data} bl'-71840)) + (\(ds-71841 : Unit-71638) -> + unsafeRatio-71648 + (unIData (headList {data} bl-71839)) + (unIData (headList {data} bl'-71840))) + (\(ds-71842 : Unit-71638) -> error {Rational-71627}) + Unit-71639)) + {all dead-71843. dead-71843} + !validateParamValues-71681 : + List-71588 ParamValue-71630 -> list data -> Bool-71608 + = \(ds-71682 : List-71588 ParamValue-71630) -> + List_match-71591 + {ParamValue-71630} + ds-71682 + {list data -> Bool-71608} + (\(eta-71683 : list data) -> + ifThenElse + {Bool-71608} + (nullList {data} eta-71683) + True-71609 + False-71610) + (\(paramValueHd-71684 : ParamValue-71630) + (paramValueTl-71685 : List-71588 ParamValue-71630) + (actualValueData-71686 : list data) -> + Bool_match-71611 + (validateParamValue-71678 + paramValueHd-71684 + (headList {data} actualValueData-71686)) + {all dead-71687. Bool-71608} + (/\dead-71688 -> + validateParamValues-71681 + paramValueTl-71685 + (tailList {data} actualValueData-71686)) + (/\dead-71689 -> False-71610) + {all dead-71690. dead-71690}) + in + let + data (Maybe-71603 :: * -> *) a-71607 | Maybe_match-71606 where + Just-71604 : a-71607 -> Maybe-71603 a-71607 + Nothing-71605 : Maybe-71603 a-71607 + in + letrec + !go-71598 : list (pair data data) -> List-71588 (Tuple2-71593 data data) + = \(l-71599 : list (pair data data)) -> + chooseList + {pair data data} + {unit -> List-71588 (Tuple2-71593 data data)} + l-71599 + (\(ds-71600 : unit) -> Nil-71589 {Tuple2-71593 data data}) + (\(ds-71601 : unit) -> + Cons-71590 + {Tuple2-71593 data data} + (let + !p-71602 : pair data data = headList {pair data data} l-71599 + in + Tuple2-71594 + {data} + {data} + (fstPair {data} {data} p-71602) + (sndPair {data} {data} p-71602)) + (go-71598 (tailList {pair data data} l-71599))) + () + in + let + !cfg-72697 : List-71588 (Tuple2-71593 integer ParamValue-71630) + = (let + a-71844 = Tuple2-71593 integer ParamValue-71630 + in + \(g-71845 : + all b-71846. + (a-71844 -> b-71846 -> b-71846) -> b-71846 -> b-71846) -> + g-71845 + {List-71588 a-71844} + (\(ds-71847 : a-71844) (ds-71848 : List-71588 a-71844) -> + Cons-71590 {a-71844} ds-71847 ds-71848) + (Nil-71589 {a-71844})) + (/\a-71849 -> + \(c-71850 : + Tuple2-71593 integer ParamValue-71630 -> a-71849 -> a-71849) + (n-71851 : a-71849) -> + c-71850 + (Tuple2-71594 {integer} - (CConsOrd - {integer} - equalsInteger - `$fOrdInteger_$ccompare` - (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) True False) - (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) - (\(x : integer) (y : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger x y) - False - True) - (\(x : integer) (y : integer) -> - ifThenElse {Bool} (lessThanInteger x y) False True) - (\(x : integer) (y : integer) -> - Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) - {all dead. integer} - (/\dead -> y) - (/\dead -> x) - {all dead. dead}) - (\(x : integer) (y : integer) -> - Bool_match - (ifThenElse - {Bool} - (lessThanEqualsInteger x y) - True - False) - {all dead. integer} - (/\dead -> x) - (/\dead -> y) - {all dead. dead})) - preds - (unIData eta)) - (\(paramValues : List ParamValue) -> - /\dead -> validateParamValues paramValues (unListData eta)) - (\(preds : (\v -> List (Tuple2 PredKey (List v))) Rational) -> - /\dead -> - validatePreds - {Rational} - (CConsOrd - {Rational} - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - Bool_match - (ifThenElse - {Bool} - (equalsInteger n n') - True - False) - {all dead. Bool} - (/\dead -> - ifThenElse - {Bool} - (equalsInteger d d') - True - False) - (/\dead -> False) - {all dead. dead}))) - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Ordering} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Ordering} - (\(n' : integer) (d' : integer) -> - `$fOrdInteger_$ccompare` - (multiplyInteger n d') - (multiplyInteger n' d)))) - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - True - False))) - `$fOrdRational0_$c<=` - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - False - True))) - (\(ds : Rational) (ds : Rational) -> - Rational_match - ds - {Bool} - (\(n : integer) (d : integer) -> - Rational_match - ds - {Bool} - (\(n' : integer) (d' : integer) -> - ifThenElse - {Bool} - (lessThanInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - False - True))) - (\(x : Rational) (y : Rational) -> - Bool_match - (`$fOrdRational0_$c<=` x y) - {all dead. Rational} - (/\dead -> y) - (/\dead -> x) - {all dead. dead}) - (\(x : Rational) (y : Rational) -> - Bool_match - (`$fOrdRational0_$c<=` x y) - {all dead. Rational} - (/\dead -> x) - (/\dead -> y) - {all dead. dead})) - preds - (ifThenElse - {Unit -> Rational} - (nullList {data} (tailList {data} bl')) - (\(ds : Unit) -> - unsafeRatio - (unIData (headList {data} bl)) - (unIData (headList {data} bl'))) - (\(ds : Unit) -> error {Rational}) - Unit)) - {all dead. dead} - !validateParamValues : List ParamValue -> list data -> Bool - = \(ds : List ParamValue) -> - List_match - {ParamValue} - ds - {list data -> Bool} - (\(eta : list data) -> - ifThenElse {Bool} (nullList {data} eta) True False) - (\(paramValueHd : ParamValue) - (paramValueTl : List ParamValue) - (actualValueData : list data) -> - Bool_match - (validateParamValue - paramValueHd - (headList {data} actualValueData)) - {all dead. Bool} - (/\dead -> - validateParamValues - paramValueTl - (tailList {data} actualValueData)) - (/\dead -> False) - {all dead. dead}) - in - let - data (Maybe :: * -> *) a | Maybe_match where - Just : a -> Maybe a - Nothing : Maybe a - in - letrec - !go : list (pair data data) -> List (Tuple2 data data) - = \(l : list (pair data data)) -> - chooseList - {pair data data} - {unit -> List (Tuple2 data data)} - l - (\(ds : unit) -> Nil {Tuple2 data data}) - (\(ds : unit) -> - Cons - {Tuple2 data data} - (let - !p : pair data data = headList {pair data data} l - in - Tuple2 - {data} - {data} - (fstPair {data} {data} p) - (sndPair {data} {data} p)) - (go (tailList {pair data data} l))) - () - in - let - !cfg : List (Tuple2 integer ParamValue) - = (let - a = Tuple2 integer ParamValue - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a})) - (/\a -> - \(c : Tuple2 integer ParamValue -> a -> a) (n : a) -> - c - (Tuple2 - {integer} - {ParamValue} - 0 - (ParamInteger - ((let - a = Tuple2 PredKey (List integer) - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : Tuple2 PredKey (List integer) -> a -> a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) (n : a) -> - c 30 (c 0 n)) - (\(ds : integer) (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) (n : a) -> - c 1000 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 1 - (ParamInteger - ((let - a = Tuple2 PredKey (List integer) - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : Tuple2 PredKey (List integer) -> a -> a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) (n : a) -> - c 100000 (c 0 n)) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 10000000 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 2 - (ParamInteger - ((let - a = Tuple2 PredKey (List integer) - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 PredKey (List integer) -> a -> a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 24576 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 122880 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 3 - (ParamInteger - ((let - a = Tuple2 PredKey (List integer) - in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 PredKey (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 0 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 32768 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 4 - (ParamInteger + {ParamValue-71630} + 0 + (ParamInteger-71632 + ((let + a-71852 + = Tuple2-71593 PredKey-71612 (List-71588 integer) + in + \(g-71853 : + all b-71854. + (a-71852 -> b-71854 -> b-71854) -> + b-71854 -> + b-71854) -> + g-71853 + {List-71588 a-71852} + (\(ds-71855 : a-71852) + (ds-71856 : List-71588 a-71852) -> + Cons-71590 {a-71852} ds-71855 ds-71856) + (Nil-71589 {a-71852})) + (/\a-71857 -> + \(c-71858 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> + a-71857 -> + a-71857) + (n-71859 : a-71857) -> + c-71858 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 ((let - a = Tuple2 PredKey (List integer) + a-71860 = List-71588 integer in - \(g : all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 PredKey (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 0 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 5000 n) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 5 - (ParamInteger + \(c-71861 : + integer -> a-71860 -> a-71860) + (n-71862 : a-71860) -> + c-71861 30 (c-71861 0 n-71862)) + (\(ds-71863 : integer) + (ds-71864 : List-71588 integer) -> + Cons-71590 + {integer} + ds-71863 + ds-71864) + (Nil-71589 {integer}))) + (c-71858 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MaxValue-71613 + ((let + a-71865 = List-71588 integer + in + \(c-71866 : + integer -> a-71865 -> a-71865) + (n-71867 : a-71865) -> + c-71866 1000 n-71867) + (\(ds-71868 : integer) + (ds-71869 : List-71588 integer) -> + Cons-71590 + {integer} + ds-71868 + ds-71869) + (Nil-71589 {integer}))) + n-71859))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 1 + (ParamInteger-71632 + ((let + a-71870 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) + in + \(g-71871 : + all b-71872. + (a-71870 -> b-71872 -> b-71872) -> + b-71872 -> + b-71872) -> + g-71871 + {List-71588 a-71870} + (\(ds-71873 : a-71870) + (ds-71874 : List-71588 a-71870) -> + Cons-71590 {a-71870} ds-71873 ds-71874) + (Nil-71589 {a-71870})) + (/\a-71875 -> + \(c-71876 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> + a-71875 -> + a-71875) + (n-71877 : a-71875) -> + c-71876 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 ((let - a = Tuple2 PredKey (List integer) + a-71878 = List-71588 integer in - \(g : - all b. (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : integer -> a -> a) - (n : a) -> - c 1000000 (c 0 n)) - (\(ds : integer) - (ds : List integer) -> - Cons {integer} ds ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : - integer -> a -> a) - (n : a) -> - c 5000000 n) - (\(ds : integer) - (ds : - List integer) -> - Cons - {integer} - ds - ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 6 - (ParamInteger + \(c-71879 : + integer -> a-71878 -> a-71878) + (n-71880 : a-71878) -> + c-71879 100000 (c-71879 0 n-71880)) + (\(ds-71881 : integer) + (ds-71882 : List-71588 integer) -> + Cons-71590 + {integer} + ds-71881 + ds-71882) + (Nil-71589 {integer}))) + (c-71876 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MaxValue-71613 ((let - a = Tuple2 PredKey (List integer) + a-71883 = List-71588 integer in - \(g : - all b. - (a -> b -> b) -> b -> b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : - integer -> a -> a) - (n : a) -> - c 250000000 (c 0 n)) - (\(ds : integer) - (ds : - List integer) -> - Cons - {integer} - ds - ds) - (Nil {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a = List integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c 500000000 n) - (\(ds : integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 7 - (ParamInteger + \(c-71884 : + integer -> a-71883 -> a-71883) + (n-71885 : a-71883) -> + c-71884 10000000 n-71885) + (\(ds-71886 : integer) + (ds-71887 : + List-71588 integer) -> + Cons-71590 + {integer} + ds-71886 + ds-71887) + (Nil-71589 {integer}))) + n-71877))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 2 + (ParamInteger-71632 + ((let + a-71888 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) + in + \(g-71889 : + all b-71890. + (a-71888 -> b-71890 -> b-71890) -> + b-71890 -> + b-71890) -> + g-71889 + {List-71588 a-71888} + (\(ds-71891 : a-71888) + (ds-71892 : List-71588 a-71888) -> + Cons-71590 {a-71888} ds-71891 ds-71892) + (Nil-71589 {a-71888})) + (/\a-71893 -> + \(c-71894 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> + a-71893 -> + a-71893) + (n-71895 : a-71893) -> + c-71894 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 + ((let + a-71896 = List-71588 integer + in + \(c-71897 : + integer -> a-71896 -> a-71896) + (n-71898 : a-71896) -> + c-71897 24576 n-71898) + (\(ds-71899 : integer) + (ds-71900 : + List-71588 integer) -> + Cons-71590 + {integer} + ds-71899 + ds-71900) + (Nil-71589 {integer}))) + (c-71894 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MaxValue-71613 + ((let + a-71901 = List-71588 integer + in + \(c-71902 : + integer -> + a-71901 -> + a-71901) + (n-71903 : a-71901) -> + c-71902 122880 n-71903) + (\(ds-71904 : integer) + (ds-71905 : + List-71588 integer) -> + Cons-71590 + {integer} + ds-71904 + ds-71905) + (Nil-71589 {integer}))) + n-71895))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 3 + (ParamInteger-71632 + ((let + a-71906 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) + in + \(g-71907 : + all b-71908. + (a-71906 -> b-71908 -> b-71908) -> + b-71908 -> + b-71908) -> + g-71907 + {List-71588 a-71906} + (\(ds-71909 : a-71906) + (ds-71910 : List-71588 a-71906) -> + Cons-71590 + {a-71906} + ds-71909 + ds-71910) + (Nil-71589 {a-71906})) + (/\a-71911 -> + \(c-71912 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> + a-71911 -> + a-71911) + (n-71913 : a-71911) -> + c-71912 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 ((let - a - = Tuple2 - PredKey - (List integer) + a-71914 = List-71588 integer in - \(g : - all b. - (a -> b -> b) -> - b -> - b) -> - g - {List a} - (\(ds : a) (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a = List integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c 0 n) - (\(ds : integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil {integer}))) - n)))) - (c - (Tuple2 - {integer} - {ParamValue} - 8 - (ParamInteger + \(c-71915 : + integer -> + a-71914 -> + a-71914) + (n-71916 : a-71914) -> + c-71915 0 n-71916) + (\(ds-71917 : integer) + (ds-71918 : + List-71588 integer) -> + Cons-71590 + {integer} + ds-71917 + ds-71918) + (Nil-71589 {integer}))) + (c-71912 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MaxValue-71613 ((let - a - = Tuple2 - PredKey - (List integer) + a-71919 + = List-71588 integer in - \(g : - all b. - (a -> b -> b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c 250 (c 0 n)) - (\(ds : integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : a) -> - c 2000 n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - NotEqual - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c 0 n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))))) - (c - (Tuple2 - {integer} - {ParamValue} - 9 - (ParamRational + \(c-71920 : + integer -> + a-71919 -> + a-71919) + (n-71921 : a-71919) -> + c-71920 32768 n-71921) + (\(ds-71922 : integer) + (ds-71923 : + List-71588 integer) -> + Cons-71590 + {integer} + ds-71922 + ds-71923) + (Nil-71589 {integer}))) + n-71913))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 4 + (ParamInteger-71632 + ((let + a-71924 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) + in + \(g-71925 : + all b-71926. + (a-71924 -> b-71926 -> b-71926) -> + b-71926 -> + b-71926) -> + g-71925 + {List-71588 a-71924} + (\(ds-71927 : a-71924) + (ds-71928 : List-71588 a-71924) -> + Cons-71590 + {a-71924} + ds-71927 + ds-71928) + (Nil-71589 {a-71924})) + (/\a-71929 -> + \(c-71930 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> + a-71929 -> + a-71929) + (n-71931 : a-71929) -> + c-71930 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 + ((let + a-71932 + = List-71588 integer + in + \(c-71933 : + integer -> + a-71932 -> + a-71932) + (n-71934 : a-71932) -> + c-71933 0 n-71934) + (\(ds-71935 : integer) + (ds-71936 : + List-71588 integer) -> + Cons-71590 + {integer} + ds-71935 + ds-71936) + (Nil-71589 {integer}))) + (c-71930 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MaxValue-71613 ((let - a - = Tuple2 - PredKey - (List Rational) + a-71937 + = List-71588 integer in - \(g : - all b. - (a -> b -> b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : a) -> - c - (unsafeRatio - 1 - 10) - (c - (unsafeRatio - 0 - 1) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 10 - (ParamRational + \(c-71938 : + integer -> + a-71937 -> + a-71937) + (n-71939 : a-71937) -> + c-71938 5000 n-71939) + (\(ds-71940 : integer) + (ds-71941 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-71940 + ds-71941) + (Nil-71589 {integer}))) + n-71931))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 5 + (ParamInteger-71632 + ((let + a-71942 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) + in + \(g-71943 : + all b-71944. + (a-71942 -> + b-71944 -> + b-71944) -> + b-71944 -> + b-71944) -> + g-71943 + {List-71588 a-71942} + (\(ds-71945 : a-71942) + (ds-71946 : + List-71588 a-71942) -> + Cons-71590 + {a-71942} + ds-71945 + ds-71946) + (Nil-71589 {a-71942})) + (/\a-71947 -> + \(c-71948 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> + a-71947 -> + a-71947) + (n-71949 : a-71947) -> + c-71948 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 + ((let + a-71950 + = List-71588 integer + in + \(c-71951 : + integer -> + a-71950 -> + a-71950) + (n-71952 : a-71950) -> + c-71951 + 1000000 + (c-71951 0 n-71952)) + (\(ds-71953 : integer) + (ds-71954 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-71953 + ds-71954) + (Nil-71589 {integer}))) + (c-71948 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MaxValue-71613 + ((let + a-71955 + = List-71588 + integer + in + \(c-71956 : + integer -> + a-71955 -> + a-71955) + (n-71957 : a-71955) -> + c-71956 + 5000000 + n-71957) + (\(ds-71958 : integer) + (ds-71959 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-71958 + ds-71959) + (Nil-71589 {integer}))) + n-71949))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 6 + (ParamInteger-71632 + ((let + a-71960 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) + in + \(g-71961 : + all b-71962. + (a-71960 -> + b-71962 -> + b-71962) -> + b-71962 -> + b-71962) -> + g-71961 + {List-71588 a-71960} + (\(ds-71963 : a-71960) + (ds-71964 : + List-71588 a-71960) -> + Cons-71590 + {a-71960} + ds-71963 + ds-71964) + (Nil-71589 {a-71960})) + (/\a-71965 -> + \(c-71966 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> + a-71965 -> + a-71965) + (n-71967 : a-71965) -> + c-71966 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 ((let - a - = Tuple2 - PredKey - (List Rational) + a-71968 + = List-71588 + integer in - \(g : - all b. - (a -> b -> b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : List a) -> - Cons {a} ds ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1000) - (c - (unsafeRatio - 0 - 1) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 200) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 11 - (ParamRational + \(c-71969 : + integer -> + a-71968 -> + a-71968) + (n-71970 : a-71968) -> + c-71969 + 250000000 + (c-71969 + 0 + n-71970)) + (\(ds-71971 : integer) + (ds-71972 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-71971 + ds-71972) + (Nil-71589 {integer}))) + (c-71966 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MaxValue-71613 + ((let + a-71973 + = List-71588 + integer + in + \(c-71974 : + integer -> + a-71973 -> + a-71973) + (n-71975 : + a-71973) -> + c-71974 + 500000000 + n-71975) + (\(ds-71976 : + integer) + (ds-71977 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-71976 + ds-71977) + (Nil-71589 + {integer}))) + n-71967))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 7 + (ParamInteger-71632 + ((let + a-71978 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) + in + \(g-71979 : + all b-71980. + (a-71978 -> + b-71980 -> + b-71980) -> + b-71980 -> + b-71980) -> + g-71979 + {List-71588 a-71978} + (\(ds-71981 : a-71978) + (ds-71982 : + List-71588 a-71978) -> + Cons-71590 + {a-71978} + ds-71981 + ds-71982) + (Nil-71589 {a-71978})) + (/\a-71983 -> + \(c-71984 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> + a-71983 -> + a-71983) + (n-71985 : a-71983) -> + c-71984 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-71986 + = List-71588 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : - List a) -> - Cons - {a} - ds - ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 10) - (c - (unsafeRatio - 0 - 1) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 3 - 10) - (c - (unsafeRatio - 1 - 1) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 16 - (ParamInteger + \(c-71987 : + integer -> + a-71986 -> + a-71986) + (n-71988 : + a-71986) -> + c-71987 0 n-71988) + (\(ds-71989 : + integer) + (ds-71990 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-71989 + ds-71990) + (Nil-71589 + {integer}))) + n-71985)))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 8 + (ParamInteger-71632 + ((let + a-71991 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) + in + \(g-71992 : + all b-71993. + (a-71991 -> + b-71993 -> + b-71993) -> + b-71993 -> + b-71993) -> + g-71992 + {List-71588 a-71991} + (\(ds-71994 : a-71991) + (ds-71995 : + List-71588 + a-71991) -> + Cons-71590 + {a-71991} + ds-71994 + ds-71995) + (Nil-71589 {a-71991})) + (/\a-71996 -> + \(c-71997 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-71996 -> + a-71996) + (n-71998 : a-71996) -> + c-71997 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} + MinValue-71614 ((let - a - = Tuple2 - PredKey - (List - integer) + a-71999 + = List-71588 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 500000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 17 - (ParamInteger + \(c-72000 : + integer -> + a-71999 -> + a-71999) + (n-72001 : + a-71999) -> + c-72000 + 250 + (c-72000 + 0 + n-72001)) + (\(ds-72002 : + integer) + (ds-72003 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72002 + ds-72003) + (Nil-71589 + {integer}))) + (c-71997 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 ((let - a - = Tuple2 - PredKey - (List - integer) + a-72004 + = List-71588 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List a} - (\(ds : a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 3000 - (c - 0 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 6500 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - NotEqual - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))))) - (c - (Tuple2 - {integer} - {ParamValue} - 18 - ParamAny) - (c - (Tuple2 - {integer} - {ParamValue} - 19 - (ParamList + \(c-72005 : + integer -> + a-72004 -> + a-72004) + (n-72006 : + a-72004) -> + c-72005 + 2000 + n-72006) + (\(ds-72007 : + integer) + (ds-72008 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72007 + ds-72008) + (Nil-71589 + {integer}))) + (c-71997 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + NotEqual-71615 + ((let + a-72009 + = List-71588 + integer + in + \(c-72010 : + integer -> + a-72009 -> + a-72009) + (n-72011 : + a-72009) -> + c-72010 + 0 + n-72011) + (\(ds-72012 : + integer) + (ds-72013 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72012 + ds-72013) + (Nil-71589 + {integer}))) + n-71998)))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 9 + (ParamRational-71634 + ((let + a-72014 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72015 : + all b-72016. + (a-72014 -> + b-72016 -> + b-72016) -> + b-72016 -> + b-72016) -> + g-72015 + {List-71588 a-72014} + (\(ds-72017 : a-72014) + (ds-72018 : + List-71588 + a-72014) -> + Cons-71590 + {a-72014} + ds-72017 + ds-72018) + (Nil-71589 {a-72014})) + (/\a-72019 -> + \(c-72020 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72019 -> + a-72019) + (n-72021 : a-72019) -> + c-72020 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72022 + = List-71588 + Rational-71627 + in + \(c-72023 : + Rational-71627 -> + a-72022 -> + a-72022) + (n-72024 : + a-72022) -> + c-72023 + (unsafeRatio-71648 + 1 + 10) + (c-72023 + (unsafeRatio-71648 + 0 + 1) + n-72024)) + (\(ds-72025 : + Rational-71627) + (ds-72026 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72025 + ds-72026) + (Nil-71589 + {Rational-71627}))) + (c-72020 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72027 + = List-71588 + Rational-71627 + in + \(c-72028 : + Rational-71627 -> + a-72027 -> + a-72027) + (n-72029 : + a-72027) -> + c-72028 + (unsafeRatio-71648 + 1 + 1) + n-72029) + (\(ds-72030 : + Rational-71627) + (ds-72031 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72030 + ds-72031) + (Nil-71589 + {Rational-71627}))) + n-72021))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 10 + (ParamRational-71634 + ((let + a-72032 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72033 : + all b-72034. + (a-72032 -> + b-72034 -> + b-72034) -> + b-72034 -> + b-72034) -> + g-72033 + {List-71588 a-72032} + (\(ds-72035 : + a-72032) + (ds-72036 : + List-71588 + a-72032) -> + Cons-71590 + {a-72032} + ds-72035 + ds-72036) + (Nil-71589 + {a-72032})) + (/\a-72037 -> + \(c-72038 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72037 -> + a-72037) + (n-72039 : + a-72037) -> + c-72038 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72040 + = List-71588 + Rational-71627 + in + \(c-72041 : + Rational-71627 -> + a-72040 -> + a-72040) + (n-72042 : + a-72040) -> + c-72041 + (unsafeRatio-71648 + 1 + 1000) + (c-72041 + (unsafeRatio-71648 + 0 + 1) + n-72042)) + (\(ds-72043 : + Rational-71627) + (ds-72044 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72043 + ds-72044) + (Nil-71589 + {Rational-71627}))) + (c-72038 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = List - ParamValue + a-72045 + = List-71588 + Rational-71627 in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 25) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 5) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 20000) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 5000) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - n)) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 20 - (ParamList + \(c-72046 : + Rational-71627 -> + a-72045 -> + a-72045) + (n-72047 : + a-72045) -> + c-72046 + (unsafeRatio-71648 + 1 + 200) + n-72047) + (\(ds-72048 : + Rational-71627) + (ds-72049 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72048 + ds-72049) + (Nil-71589 + {Rational-71627}))) + n-72039))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 11 + (ParamRational-71634 + ((let + a-72050 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72051 : + all b-72052. + (a-72050 -> + b-72052 -> + b-72052) -> + b-72052 -> + b-72052) -> + g-72051 + {List-71588 + a-72050} + (\(ds-72053 : + a-72050) + (ds-72054 : + List-71588 + a-72050) -> + Cons-71590 + {a-72050} + ds-72053 + ds-72054) + (Nil-71589 + {a-72050})) + (/\a-72055 -> + \(c-72056 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72055 -> + a-72055) + (n-72057 : + a-72055) -> + c-72056 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72058 + = List-71588 + Rational-71627 + in + \(c-72059 : + Rational-71627 -> + a-72058 -> + a-72058) + (n-72060 : + a-72058) -> + c-72059 + (unsafeRatio-71648 + 1 + 10) + (c-72059 + (unsafeRatio-71648 + 0 + 1) + n-72060)) + (\(ds-72061 : + Rational-71627) + (ds-72062 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72061 + ds-72062) + (Nil-71589 + {Rational-71627}))) + (c-72056 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = List - ParamValue + a-72063 + = List-71588 + Rational-71627 in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 40000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - (c - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 15000000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - n)) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 21 - (ParamList + \(c-72064 : + Rational-71627 -> + a-72063 -> + a-72063) + (n-72065 : + a-72063) -> + c-72064 + (unsafeRatio-71648 + 3 + 10) + (c-72064 + (unsafeRatio-71648 + 1 + 1) + n-72065)) + (\(ds-72066 : + Rational-71627) + (ds-72067 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72066 + ds-72067) + (Nil-71589 + {Rational-71627}))) + n-72057))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 16 + (ParamInteger-71632 + ((let + a-72068 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72069 : + all b-72070. + (a-72068 -> + b-72070 -> + b-72070) -> + b-72070 -> + b-72070) -> + g-72069 + {List-71588 + a-72068} + (\(ds-72071 : + a-72068) + (ds-72072 : + List-71588 + a-72068) -> + Cons-71590 + {a-72068} + ds-72071 + ds-72072) + (Nil-71589 + {a-72068})) + (/\a-72073 -> + \(c-72074 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72073 -> + a-72073) + (n-72075 : + a-72073) -> + c-72074 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72076 + = List-71588 + integer + in + \(c-72077 : + integer -> + a-72076 -> + a-72076) + (n-72078 : + a-72076) -> + c-72077 + 0 + n-72078) + (\(ds-72079 : + integer) + (ds-72080 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72079 + ds-72080) + (Nil-71589 + {integer}))) + (c-72074 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 ((let - a - = List - ParamValue + a-72081 + = List-71588 + integer in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 120000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - (c - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 40000000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))) - n)) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 22 - (ParamInteger + \(c-72082 : + integer -> + a-72081 -> + a-72081) + (n-72083 : + a-72081) -> + c-72082 + 500000000 + n-72083) + (\(ds-72084 : + integer) + (ds-72085 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72084 + ds-72085) + (Nil-71589 + {integer}))) + n-72075))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 17 + (ParamInteger-71632 + ((let + a-72086 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72087 : + all b-72088. + (a-72086 -> + b-72088 -> + b-72088) -> + b-72088 -> + b-72088) -> + g-72087 + {List-71588 + a-72086} + (\(ds-72089 : + a-72086) + (ds-72090 : + List-71588 + a-72086) -> + Cons-71590 + {a-72086} + ds-72089 + ds-72090) + (Nil-71589 + {a-72086})) + (/\a-72091 -> + \(c-72092 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72091 -> + a-72091) + (n-72093 : + a-72091) -> + c-72092 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72094 + = List-71588 + integer + in + \(c-72095 : + integer -> + a-72094 -> + a-72094) + (n-72096 : + a-72094) -> + c-72095 + 3000 + (c-72095 + 0 + n-72096)) + (\(ds-72097 : + integer) + (ds-72098 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72097 + ds-72098) + (Nil-71589 + {integer}))) + (c-72092 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72099 + = List-71588 + integer + in + \(c-72100 : + integer -> + a-72099 -> + a-72099) + (n-72101 : + a-72099) -> + c-72100 + 6500 + n-72101) + (\(ds-72102 : + integer) + (ds-72103 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72102 + ds-72103) + (Nil-71589 + {integer}))) + (c-72092 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + NotEqual-71615 + ((let + a-72104 + = List-71588 + integer + in + \(c-72105 : + integer -> + a-72104 -> + a-72104) + (n-72106 : + a-72104) -> + c-72105 + 0 + n-72106) + (\(ds-72107 : + integer) + (ds-72108 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72107 + ds-72108) + (Nil-71589 + {integer}))) + n-72093)))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 18 + ParamAny-71631) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 19 + (ParamList-71633 + ((let + a-72109 + = List-71588 + ParamValue-71630 + in + \(c-72110 : + ParamValue-71630 -> + a-72109 -> + a-72109) + (n-72111 : + a-72109) -> + c-72110 + (ParamRational-71634 ((let - a - = Tuple2 - PredKey - (List - integer) + a-72112 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-72113 : + all b-72114. + (a-72112 -> + b-72114 -> + b-72114) -> + b-72114 -> + b-72114) -> + g-72113 + {List-71588 + a-72112} + (\(ds-72115 : + a-72112) + (ds-72116 : + List-71588 + a-72112) -> + Cons-71590 + {a-72112} + ds-72115 + ds-72116) + (Nil-71589 + {a-72112})) + (/\a-72117 -> + \(c-72118 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72117 -> + a-72117) + (n-72119 : + a-72117) -> + c-72118 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = List - integer + a-72120 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-72121 : + Rational-71627 -> + a-72120 -> + a-72120) + (n-72122 : + a-72120) -> + c-72121 + (unsafeRatio-71648 + 1 + 25) + n-72122) + (\(ds-72123 : + Rational-71627) + (ds-72124 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72123 + ds-72124) + (Nil-71589 + {Rational-71627}))) + (c-72118 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = List - integer + a-72125 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 12288 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 23 - (ParamInteger + \(c-72126 : + Rational-71627 -> + a-72125 -> + a-72125) + (n-72127 : + a-72125) -> + c-72126 + (unsafeRatio-71648 + 1 + 5) + n-72127) + (\(ds-72128 : + Rational-71627) + (ds-72129 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72128 + ds-72129) + (Nil-71589 + {Rational-71627}))) + n-72119)))) + (c-72110 + (ParamRational-71634 + ((let + a-72130 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72131 : + all b-72132. + (a-72130 -> + b-72132 -> + b-72132) -> + b-72132 -> + b-72132) -> + g-72131 + {List-71588 + a-72130} + (\(ds-72133 : + a-72130) + (ds-72134 : + List-71588 + a-72130) -> + Cons-71590 + {a-72130} + ds-72133 + ds-72134) + (Nil-71589 + {a-72130})) + (/\a-72135 -> + \(c-72136 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72135 -> + a-72135) + (n-72137 : + a-72135) -> + c-72136 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72138 + = List-71588 + Rational-71627 + in + \(c-72139 : + Rational-71627 -> + a-72138 -> + a-72138) + (n-72140 : + a-72138) -> + c-72139 + (unsafeRatio-71648 + 1 + 20000) + n-72140) + (\(ds-72141 : + Rational-71627) + (ds-72142 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72141 + ds-72142) + (Nil-71589 + {Rational-71627}))) + (c-72136 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72143 + = List-71588 + Rational-71627 + in + \(c-72144 : + Rational-71627 -> + a-72143 -> + a-72143) + (n-72145 : + a-72143) -> + c-72144 + (unsafeRatio-71648 + 1 + 5000) + n-72145) + (\(ds-72146 : + Rational-71627) + (ds-72147 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72146 + ds-72147) + (Nil-71589 + {Rational-71627}))) + n-72137)))) + n-72111)) + (\(ds-72148 : + ParamValue-71630) + (ds-72149 : + List-71588 + ParamValue-71630) -> + Cons-71590 + {ParamValue-71630} + ds-72148 + ds-72149) + (Nil-71589 + {ParamValue-71630})))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 20 + (ParamList-71633 + ((let + a-72150 + = List-71588 + ParamValue-71630 + in + \(c-72151 : + ParamValue-71630 -> + a-72150 -> + a-72150) + (n-72152 : + a-72150) -> + c-72151 + (ParamInteger-71632 ((let - a - = Tuple2 - PredKey - (List + a-72153 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List + \(g-72154 : + all b-72155. + (a-72153 -> + b-72155 -> + b-72155) -> + b-72155 -> + b-72155) -> + g-72154 + {List-71588 + a-72153} + (\(ds-72156 : + a-72153) + (ds-72157 : + List-71588 + a-72153) -> + Cons-71590 + {a-72153} + ds-72156 + ds-72157) + (Nil-71589 + {a-72153})) + (/\a-72158 -> + \(c-72159 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List + a-72158 -> + a-72158) + (n-72160 : + a-72158) -> + c-72159 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} - MinValue + MinValue-71614 ((let - a - = List + a-72161 + = List-71588 integer in - \(c : + \(c-72162 : integer -> - a -> - a) - (n : - a) -> - c - 100 - (c - 0 - n)) - (\(ds : + a-72161 -> + a-72161) + (n-72163 : + a-72161) -> + c-72162 + 0 + n-72163) + (\(ds-72164 : integer) - (ds : - List + (ds-72165 : + List-71588 integer) -> - Cons + Cons-71590 {integer} - ds - ds) - (Nil + ds-72164 + ds-72165) + (Nil-71589 {integer}))) - (c - (Tuple2 - {PredKey} - {List + (c-72159 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72166 + = List-71588 + integer + in + \(c-72167 : + integer -> + a-72166 -> + a-72166) + (n-72168 : + a-72166) -> + c-72167 + 40000000 + n-72168) + (\(ds-72169 : + integer) + (ds-72170 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72169 + ds-72170) + (Nil-71589 + {integer}))) + n-72160)))) + (c-72151 + (ParamInteger-71632 + ((let + a-72171 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72172 : + all b-72173. + (a-72171 -> + b-72173 -> + b-72173) -> + b-72173 -> + b-72173) -> + g-72172 + {List-71588 + a-72171} + (\(ds-72174 : + a-72171) + (ds-72175 : + List-71588 + a-72171) -> + Cons-71590 + {a-72171} + ds-72174 + ds-72175) + (Nil-71589 + {a-72171})) + (/\a-72176 -> + \(c-72177 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72176 -> + a-72176) + (n-72178 : + a-72176) -> + c-72177 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} - MaxValue + MinValue-71614 ((let - a - = List + a-72179 + = List-71588 integer in - \(c : + \(c-72180 : integer -> - a -> - a) - (n : - a) -> - c - 200 - n) - (\(ds : + a-72179 -> + a-72179) + (n-72181 : + a-72179) -> + c-72180 + 0 + n-72181) + (\(ds-72182 : integer) - (ds : - List + (ds-72183 : + List-71588 integer) -> - Cons + Cons-71590 {integer} - ds - ds) - (Nil + ds-72182 + ds-72183) + (Nil-71589 {integer}))) - (c - (Tuple2 - {PredKey} - {List + (c-72177 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} - NotEqual + MaxValue-71613 ((let - a - = List + a-72184 + = List-71588 integer in - \(c : + \(c-72185 : integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : + a-72184 -> + a-72184) + (n-72186 : + a-72184) -> + c-72185 + 15000000000 + n-72186) + (\(ds-72187 : integer) - (ds : - List + (ds-72188 : + List-71588 integer) -> - Cons + Cons-71590 {integer} - ds - ds) - (Nil + ds-72187 + ds-72188) + (Nil-71589 {integer}))) - n)))))) - (c - (Tuple2 - {integer} - {ParamValue} - 24 - (ParamInteger + n-72178)))) + n-72152)) + (\(ds-72189 : + ParamValue-71630) + (ds-72190 : + List-71588 + ParamValue-71630) -> + Cons-71590 + {ParamValue-71630} + ds-72189 + ds-72190) + (Nil-71589 + {ParamValue-71630})))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 21 + (ParamList-71633 + ((let + a-72191 + = List-71588 + ParamValue-71630 + in + \(c-72192 : + ParamValue-71630 -> + a-72191 -> + a-72191) + (n-72193 : + a-72191) -> + c-72192 + (ParamInteger-71632 ((let - a - = Tuple2 - PredKey - (List + a-72194 + = Tuple2-71593 + PredKey-71612 + (List-71588 integer) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List + \(g-72195 : + all b-72196. + (a-72194 -> + b-72196 -> + b-72196) -> + b-72196 -> + b-72196) -> + g-72195 + {List-71588 + a-72194} + (\(ds-72197 : + a-72194) + (ds-72198 : + List-71588 + a-72194) -> + Cons-71590 + {a-72194} + ds-72197 + ds-72198) + (Nil-71589 + {a-72194})) + (/\a-72199 -> + \(c-72200 : + Tuple2-71593 + PredKey-71612 + (List-71588 integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List + a-72199 -> + a-72199) + (n-72201 : + a-72199) -> + c-72200 + (Tuple2-71594 + {PredKey-71612} + {List-71588 integer} - MinValue + MinValue-71614 ((let - a - = List + a-72202 + = List-71588 integer in - \(c : + \(c-72203 : integer -> - a -> - a) - (n : - a) -> - c - 1 - n) - (\(ds : + a-72202 -> + a-72202) + (n-72204 : + a-72202) -> + c-72203 + 0 + n-72204) + (\(ds-72205 : integer) - (ds : - List + (ds-72206 : + List-71588 integer) -> - Cons + Cons-71590 {integer} - ds - ds) - (Nil + ds-72205 + ds-72206) + (Nil-71589 {integer}))) - n)))) - (c - (Tuple2 - {integer} - {ParamValue} - 25 - (ParamList + (c-72200 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72207 + = List-71588 + integer + in + \(c-72208 : + integer -> + a-72207 -> + a-72207) + (n-72209 : + a-72207) -> + c-72208 + 120000000 + n-72209) + (\(ds-72210 : + integer) + (ds-72211 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72210 + ds-72211) + (Nil-71589 + {integer}))) + n-72201)))) + (c-72192 + (ParamInteger-71632 ((let - a - = List - ParamValue + a-72212 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(g-72213 : + all b-72214. + (a-72212 -> + b-72214 -> + b-72214) -> + b-72214 -> + b-72214) -> + g-72213 + {List-71588 + a-72212} + (\(ds-72215 : + a-72212) + (ds-72216 : + List-71588 + a-72212) -> + Cons-71590 + {a-72212} + ds-72215 + ds-72216) + (Nil-71589 + {a-72212})) + (/\a-72217 -> + \(c-72218 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72217 -> + a-72217) + (n-72219 : + a-72217) -> + c-72218 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72220 + = List-71588 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-72221 : + integer -> + a-72220 -> + a-72220) + (n-72222 : + a-72220) -> + c-72221 + 0 + n-72222) + (\(ds-72223 : + integer) + (ds-72224 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72223 + ds-72224) + (Nil-71589 + {integer}))) + (c-72218 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72225 + = List-71588 + integer in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 4 - 5) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - n))))) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 26 - (ParamList + \(c-72226 : + integer -> + a-72225 -> + a-72225) + (n-72227 : + a-72225) -> + c-72226 + 40000000000 + n-72227) + (\(ds-72228 : + integer) + (ds-72229 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72228 + ds-72229) + (Nil-71589 + {integer}))) + n-72219)))) + n-72193)) + (\(ds-72230 : + ParamValue-71630) + (ds-72231 : + List-71588 + ParamValue-71630) -> + Cons-71590 + {ParamValue-71630} + ds-72230 + ds-72231) + (Nil-71589 + {ParamValue-71630})))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 22 + (ParamInteger-71632 + ((let + a-72232 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72233 : + all b-72234. + (a-72232 -> + b-72234 -> + b-72234) -> + b-72234 -> + b-72234) -> + g-72233 + {List-71588 + a-72232} + (\(ds-72235 : + a-72232) + (ds-72236 : + List-71588 + a-72232) -> + Cons-71590 + {a-72232} + ds-72235 + ds-72236) + (Nil-71589 + {a-72232})) + (/\a-72237 -> + \(c-72238 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72237 -> + a-72237) + (n-72239 : + a-72237) -> + c-72238 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 ((let - a - = List - ParamValue + a-72240 + = List-71588 + integer in - \(c : - ParamValue -> - a -> - a) - (n : - a) -> - c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-72241 : + integer -> + a-72240 -> + a-72240) + (n-72242 : + a-72240) -> + c-72241 + 0 + n-72242) + (\(ds-72243 : + integer) + (ds-72244 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72243 + ds-72244) + (Nil-71589 + {integer}))) + (c-72238 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72245 + = List-71588 + integer + in + \(c-72246 : + integer -> + a-72245 -> + a-72245) + (n-72247 : + a-72245) -> + c-72246 + 12288 + n-72247) + (\(ds-72248 : + integer) + (ds-72249 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72248 + ds-72249) + (Nil-71589 + {integer}))) + n-72239))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 23 + (ParamInteger-71632 + ((let + a-72250 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72251 : + all b-72252. + (a-72250 -> + b-72252 -> + b-72252) -> + b-72252 -> + b-72252) -> + g-72251 + {List-71588 + a-72250} + (\(ds-72253 : + a-72250) + (ds-72254 : + List-71588 + a-72250) -> + Cons-71590 + {a-72250} + ds-72253 + ds-72254) + (Nil-71589 + {a-72250})) + (/\a-72255 -> + \(c-72256 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72255 -> + a-72255) + (n-72257 : + a-72255) -> + c-72256 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72258 + = List-71588 + integer + in + \(c-72259 : + integer -> + a-72258 -> + a-72258) + (n-72260 : + a-72258) -> + c-72259 + 100 + (c-72259 + 0 + n-72260)) + (\(ds-72261 : + integer) + (ds-72262 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72261 + ds-72262) + (Nil-71589 + {integer}))) + (c-72256 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72263 + = List-71588 + integer + in + \(c-72264 : + integer -> + a-72263 -> + a-72263) + (n-72265 : + a-72263) -> + c-72264 + 200 + n-72265) + (\(ds-72266 : + integer) + (ds-72267 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72266 + ds-72267) + (Nil-71589 + {integer}))) + (c-72256 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + NotEqual-71615 + ((let + a-72268 + = List-71588 + integer + in + \(c-72269 : + integer -> + a-72268 -> + a-72268) + (n-72270 : + a-72268) -> + c-72269 + 0 + n-72270) + (\(ds-72271 : + integer) + (ds-72272 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72271 + ds-72272) + (Nil-71589 + {integer}))) + n-72257)))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 24 + (ParamInteger-71632 + ((let + a-72273 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72274 : + all b-72275. + (a-72273 -> + b-72275 -> + b-72275) -> + b-72275 -> + b-72275) -> + g-72274 + {List-71588 + a-72273} + (\(ds-72276 : + a-72273) + (ds-72277 : + List-71588 + a-72273) -> + Cons-71590 + {a-72273} + ds-72276 + ds-72277) + (Nil-71589 + {a-72273})) + (/\a-72278 -> + \(c-72279 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72278 -> + a-72278) + (n-72280 : + a-72278) -> + c-72279 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72281 + = List-71588 + integer + in + \(c-72282 : + integer -> + a-72281 -> + a-72281) + (n-72283 : + a-72281) -> + c-72282 + 1 + n-72283) + (\(ds-72284 : + integer) + (ds-72285 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72284 + ds-72285) + (Nil-71589 + {integer}))) + n-72280)))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 25 + (ParamList-71633 + ((let + a-72286 + = List-71588 + ParamValue-71630 + in + \(c-72287 : + ParamValue-71630 -> + a-72286 -> + a-72286) + (n-72288 : + a-72286) -> + c-72287 + (ParamRational-71634 + ((let + a-72289 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72290 : + all b-72291. + (a-72289 -> + b-72291 -> + b-72291) -> + b-72291 -> + b-72291) -> + g-72290 + {List-71588 + a-72289} + (\(ds-72292 : + a-72289) + (ds-72293 : + List-71588 + a-72289) -> + Cons-71590 + {a-72289} + ds-72292 + ds-72293) + (Nil-71589 + {a-72289})) + (/\a-72294 -> + \(c-72295 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72294 -> + a-72294) + (n-72296 : + a-72294) -> + c-72295 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72297 + = List-71588 + Rational-71627 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 13 - 20) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-72298 : + Rational-71627 -> + a-72297 -> + a-72297) + (n-72299 : + a-72297) -> + c-72298 + (unsafeRatio-71648 + 1 + 2) + (c-72298 + (unsafeRatio-71648 + 51 + 100) + n-72299)) + (\(ds-72300 : + Rational-71627) + (ds-72301 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72300 + ds-72301) + (Nil-71589 + {Rational-71627}))) + (c-72295 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72302 + = List-71588 + Rational-71627 + in + \(c-72303 : + Rational-71627 -> + a-72302 -> + a-72302) + (n-72304 : + a-72302) -> + c-72303 + (unsafeRatio-71648 + 1 + 1) + (c-72303 + (unsafeRatio-71648 + 3 + 4) + n-72304)) + (\(ds-72305 : + Rational-71627) + (ds-72306 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72305 + ds-72306) + (Nil-71589 + {Rational-71627}))) + n-72296)))) + (c-72287 + (ParamRational-71634 + ((let + a-72307 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72308 : + all b-72309. + (a-72307 -> + b-72309 -> + b-72309) -> + b-72309 -> + b-72309) -> + g-72308 + {List-71588 + a-72307} + (\(ds-72310 : + a-72307) + (ds-72311 : + List-71588 + a-72307) -> + Cons-71590 + {a-72307} + ds-72310 + ds-72311) + (Nil-71589 + {a-72307})) + (/\a-72312 -> + \(c-72313 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72312 -> + a-72312) + (n-72314 : + a-72312) -> + c-72313 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72315 + = List-71588 + Rational-71627 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 4 - 5) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-72316 : + Rational-71627 -> + a-72315 -> + a-72315) + (n-72317 : + a-72315) -> + c-72316 + (unsafeRatio-71648 + 1 + 2) + (c-72316 + (unsafeRatio-71648 + 13 + 20) + n-72317)) + (\(ds-72318 : + Rational-71627) + (ds-72319 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72318 + ds-72319) + (Nil-71589 + {Rational-71627}))) + (c-72313 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72320 + = List-71588 + Rational-71627 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-72321 : + Rational-71627 -> + a-72320 -> + a-72320) + (n-72322 : + a-72320) -> + c-72321 + (unsafeRatio-71648 + 1 + 1) + (c-72321 + (unsafeRatio-71648 + 9 + 10) + n-72322)) + (\(ds-72323 : + Rational-71627) + (ds-72324 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72323 + ds-72324) + (Nil-71589 + {Rational-71627}))) + n-72314)))) + (c-72287 + (ParamRational-71634 + ((let + a-72325 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72326 : + all b-72327. + (a-72325 -> + b-72327 -> + b-72327) -> + b-72327 -> + b-72327) -> + g-72326 + {List-71588 + a-72325} + (\(ds-72328 : + a-72325) + (ds-72329 : + List-71588 + a-72325) -> + Cons-71590 + {a-72325} + ds-72328 + ds-72329) + (Nil-71589 + {a-72325})) + (/\a-72330 -> + \(c-72331 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72330 -> + a-72330) + (n-72332 : + a-72330) -> + c-72331 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72333 + = List-71588 + Rational-71627 + in + \(c-72334 : + Rational-71627 -> + a-72333 -> + a-72333) + (n-72335 : + a-72333) -> + c-72334 + (unsafeRatio-71648 + 1 + 2) + (c-72334 + (unsafeRatio-71648 + 13 + 20) + n-72335)) + (\(ds-72336 : + Rational-71627) + (ds-72337 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72336 + ds-72337) + (Nil-71589 + {Rational-71627}))) + (c-72331 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72338 + = List-71588 + Rational-71627 + in + \(c-72339 : + Rational-71627 -> + a-72338 -> + a-72338) + (n-72340 : + a-72338) -> + c-72339 + (unsafeRatio-71648 + 1 + 1) + (c-72339 + (unsafeRatio-71648 + 9 + 10) + n-72340)) + (\(ds-72341 : + Rational-71627) + (ds-72342 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72341 + ds-72342) + (Nil-71589 + {Rational-71627}))) + n-72332)))) + (c-72287 + (ParamRational-71634 + ((let + a-72343 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72344 : + all b-72345. + (a-72343 -> + b-72345 -> + b-72345) -> + b-72345 -> + b-72345) -> + g-72344 + {List-71588 + a-72343} + (\(ds-72346 : + a-72343) + (ds-72347 : + List-71588 + a-72343) -> + Cons-71590 + {a-72343} + ds-72346 + ds-72347) + (Nil-71589 + {a-72343})) + (/\a-72348 -> + \(c-72349 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72348 -> + a-72348) + (n-72350 : + a-72348) -> + c-72349 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72351 + = List-71588 + Rational-71627 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-72352 : + Rational-71627 -> + a-72351 -> + a-72351) + (n-72353 : + a-72351) -> + c-72352 + (unsafeRatio-71648 + 1 + 2) + (c-72352 + (unsafeRatio-71648 + 51 + 100) + n-72353)) + (\(ds-72354 : + Rational-71627) + (ds-72355 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72354 + ds-72355) + (Nil-71589 + {Rational-71627}))) + (c-72349 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72356 + = List-71588 + Rational-71627 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 51 - 100) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational + \(c-72357 : + Rational-71627 -> + a-72356 -> + a-72356) + (n-72358 : + a-72356) -> + c-72357 + (unsafeRatio-71648 + 1 + 1) + (c-72357 + (unsafeRatio-71648 + 4 + 5) + n-72358)) + (\(ds-72359 : + Rational-71627) + (ds-72360 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72359 + ds-72360) + (Nil-71589 + {Rational-71627}))) + n-72350)))) + (c-72287 + (ParamRational-71634 + ((let + a-72361 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72362 : + all b-72363. + (a-72361 -> + b-72363 -> + b-72363) -> + b-72363 -> + b-72363) -> + g-72362 + {List-71588 + a-72361} + (\(ds-72364 : + a-72361) + (ds-72365 : + List-71588 + a-72361) -> + Cons-71590 + {a-72361} + ds-72364 + ds-72365) + (Nil-71589 + {a-72361})) + (/\a-72366 -> + \(c-72367 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72366 -> + a-72366) + (n-72368 : + a-72366) -> + c-72367 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72369 + = List-71588 + Rational-71627 + in + \(c-72370 : + Rational-71627 -> + a-72369 -> + a-72369) + (n-72371 : + a-72369) -> + c-72370 + (unsafeRatio-71648 + 1 + 2) + n-72371) + (\(ds-72372 : + Rational-71627) + (ds-72373 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72372 + ds-72373) + (Nil-71589 + {Rational-71627}))) + (c-72367 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72374 + = List-71588 + Rational-71627 in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - (c - (unsafeRatio - 3 - 4) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - (c - (unsafeRatio - 9 - 10) - n)) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - (c - (ParamRational - ((let - a - = Tuple2 - PredKey - (List - Rational) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 2) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue - ((let - a - = List - Rational - in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1 - 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n)))) - n)))))))))) - (\(ds : - ParamValue) - (ds : - List - ParamValue) -> - Cons - {ParamValue} - ds - ds) - (Nil - {ParamValue})))) - (c - (Tuple2 - {integer} - {ParamValue} - 27 - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - (c - 3 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 10 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 28 - (ParamInteger - ((let - a - = Tuple2 - PredKey - (List - integer) - in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - (c - 18 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 293 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - NotEqual - ((let - a - = List - integer - in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n)))))) - (c - (Tuple2 - {integer} - {ParamValue} - 29 - (ParamInteger + \(c-72375 : + Rational-71627 -> + a-72374 -> + a-72374) + (n-72376 : + a-72374) -> + c-72375 + (unsafeRatio-71648 + 1 + 1) + n-72376) + (\(ds-72377 : + Rational-71627) + (ds-72378 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72377 + ds-72378) + (Nil-71589 + {Rational-71627}))) + n-72368)))) + n-72288))))) + (\(ds-72379 : + ParamValue-71630) + (ds-72380 : + List-71588 + ParamValue-71630) -> + Cons-71590 + {ParamValue-71630} + ds-72379 + ds-72380) + (Nil-71589 + {ParamValue-71630})))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 26 + (ParamList-71633 + ((let + a-72381 + = List-71588 + ParamValue-71630 + in + \(c-72382 : + ParamValue-71630 -> + a-72381 -> + a-72381) + (n-72383 : + a-72381) -> + c-72382 + (ParamRational-71634 ((let - a - = Tuple2 - PredKey - (List - integer) + a-72384 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-72385 : + all b-72386. + (a-72384 -> + b-72386 -> + b-72386) -> + b-72386 -> + b-72386) -> + g-72385 + {List-71588 + a-72384} + (\(ds-72387 : + a-72384) + (ds-72388 : + List-71588 + a-72384) -> + Cons-71590 + {a-72384} + ds-72387 + ds-72388) + (Nil-71589 + {a-72384})) + (/\a-72389 -> + \(c-72390 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72389 -> + a-72389) + (n-72391 : + a-72389) -> + c-72390 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = List - integer + a-72392 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 1 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-72393 : + Rational-71627 -> + a-72392 -> + a-72392) + (n-72394 : + a-72392) -> + c-72393 + (unsafeRatio-71648 + 1 + 2) + (c-72393 + (unsafeRatio-71648 + 51 + 100) + n-72394)) + (\(ds-72395 : + Rational-71627) + (ds-72396 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72395 + ds-72396) + (Nil-71589 + {Rational-71627}))) + (c-72390 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = List - integer + a-72397 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 15 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 30 - (ParamInteger + \(c-72398 : + Rational-71627 -> + a-72397 -> + a-72397) + (n-72399 : + a-72397) -> + c-72398 + (unsafeRatio-71648 + 1 + 1) + (c-72398 + (unsafeRatio-71648 + 3 + 4) + n-72399)) + (\(ds-72400 : + Rational-71627) + (ds-72401 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72400 + ds-72401) + (Nil-71589 + {Rational-71627}))) + n-72391)))) + (c-72382 + (ParamRational-71634 ((let - a - = Tuple2 - PredKey - (List - integer) + a-72402 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-72403 : + all b-72404. + (a-72402 -> + b-72404 -> + b-72404) -> + b-72404 -> + b-72404) -> + g-72403 + {List-71588 + a-72402} + (\(ds-72405 : + a-72402) + (ds-72406 : + List-71588 + a-72402) -> + Cons-71590 + {a-72402} + ds-72405 + ds-72406) + (Nil-71589 + {a-72402})) + (/\a-72407 -> + \(c-72408 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72407 -> + a-72407) + (n-72409 : + a-72407) -> + c-72408 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = List - integer + a-72410 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - (c - 1000000 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-72411 : + Rational-71627 -> + a-72410 -> + a-72410) + (n-72412 : + a-72410) -> + c-72411 + (unsafeRatio-71648 + 1 + 2) + (c-72411 + (unsafeRatio-71648 + 13 + 20) + n-72412)) + (\(ds-72413 : + Rational-71627) + (ds-72414 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72413 + ds-72414) + (Nil-71589 + {Rational-71627}))) + (c-72408 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = List - integer + a-72415 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 10000000000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 31 - (ParamInteger + \(c-72416 : + Rational-71627 -> + a-72415 -> + a-72415) + (n-72417 : + a-72415) -> + c-72416 + (unsafeRatio-71648 + 1 + 1) + (c-72416 + (unsafeRatio-71648 + 9 + 10) + n-72417)) + (\(ds-72418 : + Rational-71627) + (ds-72419 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72418 + ds-72419) + (Nil-71589 + {Rational-71627}))) + n-72409)))) + (c-72382 + (ParamRational-71634 ((let - a - = Tuple2 - PredKey - (List - integer) + a-72420 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-72421 : + all b-72422. + (a-72420 -> + b-72422 -> + b-72422) -> + b-72422 -> + b-72422) -> + g-72421 + {List-71588 + a-72420} + (\(ds-72423 : + a-72420) + (ds-72424 : + List-71588 + a-72420) -> + Cons-71590 + {a-72420} + ds-72423 + ds-72424) + (Nil-71589 + {a-72420})) + (/\a-72425 -> + \(c-72426 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72425 -> + a-72425) + (n-72427 : + a-72425) -> + c-72426 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = List - integer + a-72428 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 0 - (c - 1000000 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-72429 : + Rational-71627 -> + a-72428 -> + a-72428) + (n-72430 : + a-72428) -> + c-72429 + (unsafeRatio-71648 + 1 + 2) + (c-72429 + (unsafeRatio-71648 + 13 + 20) + n-72430)) + (\(ds-72431 : + Rational-71627) + (ds-72432 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72431 + ds-72432) + (Nil-71589 + {Rational-71627}))) + (c-72426 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = List - integer + a-72433 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 100000000000 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 32 - (ParamInteger + \(c-72434 : + Rational-71627 -> + a-72433 -> + a-72433) + (n-72435 : + a-72433) -> + c-72434 + (unsafeRatio-71648 + 1 + 1) + (c-72434 + (unsafeRatio-71648 + 9 + 10) + n-72435)) + (\(ds-72436 : + Rational-71627) + (ds-72437 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72436 + ds-72437) + (Nil-71589 + {Rational-71627}))) + n-72427)))) + (c-72382 + (ParamRational-71634 ((let - a - = Tuple2 - PredKey - (List - integer) + a-72438 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - integer) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - integer} - MinValue + \(g-72439 : + all b-72440. + (a-72438 -> + b-72440 -> + b-72440) -> + b-72440 -> + b-72440) -> + g-72439 + {List-71588 + a-72438} + (\(ds-72441 : + a-72438) + (ds-72442 : + List-71588 + a-72438) -> + Cons-71590 + {a-72438} + ds-72441 + ds-72442) + (Nil-71589 + {a-72438})) + (/\a-72443 -> + \(c-72444 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72443 -> + a-72443) + (n-72445 : + a-72443) -> + c-72444 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = List - integer + a-72446 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 13 - (c - 0 - n)) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - (c - (Tuple2 - {PredKey} - {List - integer} - MaxValue + \(c-72447 : + Rational-71627 -> + a-72446 -> + a-72446) + (n-72448 : + a-72446) -> + c-72447 + (unsafeRatio-71648 + 1 + 2) + (c-72447 + (unsafeRatio-71648 + 13 + 20) + n-72448)) + (\(ds-72449 : + Rational-71627) + (ds-72450 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72449 + ds-72450) + (Nil-71589 + {Rational-71627}))) + (c-72444 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = List - integer + a-72451 + = List-71588 + Rational-71627 in - \(c : - integer -> - a -> - a) - (n : - a) -> - c - 37 - n) - (\(ds : - integer) - (ds : - List - integer) -> - Cons - {integer} - ds - ds) - (Nil - {integer}))) - n))))) - (c - (Tuple2 - {integer} - {ParamValue} - 33 - (ParamRational + \(c-72452 : + Rational-71627 -> + a-72451 -> + a-72451) + (n-72453 : + a-72451) -> + c-72452 + (unsafeRatio-71648 + 1 + 1) + (c-72452 + (unsafeRatio-71648 + 9 + 10) + n-72453)) + (\(ds-72454 : + Rational-71627) + (ds-72455 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72454 + ds-72455) + (Nil-71589 + {Rational-71627}))) + n-72445)))) + (c-72382 + (ParamRational-71634 ((let - a - = Tuple2 - PredKey - (List - Rational) + a-72456 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) in - \(g : - all b. - (a -> - b -> - b) -> - b -> - b) -> - g - {List - a} - (\(ds : - a) - (ds : - List - a) -> - Cons - {a} - ds - ds) - (Nil - {a})) - (/\a -> - \(c : - Tuple2 - PredKey - (List - Rational) -> - a -> - a) - (n : - a) -> - c - (Tuple2 - {PredKey} - {List - Rational} - MinValue + \(g-72457 : + all b-72458. + (a-72456 -> + b-72458 -> + b-72458) -> + b-72458 -> + b-72458) -> + g-72457 + {List-71588 + a-72456} + (\(ds-72459 : + a-72456) + (ds-72460 : + List-71588 + a-72456) -> + Cons-71590 + {a-72456} + ds-72459 + ds-72460) + (Nil-71589 + {a-72456})) + (/\a-72461 -> + \(c-72462 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72461 -> + a-72461) + (n-72463 : + a-72461) -> + c-72462 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 ((let - a - = List - Rational + a-72464 + = List-71588 + Rational-71627 in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 0 - 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - (c - (Tuple2 - {PredKey} - {List - Rational} - MaxValue + \(c-72465 : + Rational-71627 -> + a-72464 -> + a-72464) + (n-72466 : + a-72464) -> + c-72465 + (unsafeRatio-71648 + 1 + 2) + (c-72465 + (unsafeRatio-71648 + 51 + 100) + n-72466)) + (\(ds-72467 : + Rational-71627) + (ds-72468 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72467 + ds-72468) + (Nil-71589 + {Rational-71627}))) + (c-72462 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 ((let - a - = List - Rational + a-72469 + = List-71588 + Rational-71627 in - \(c : - Rational -> - a -> - a) - (n : - a) -> - c - (unsafeRatio - 1000 + \(c-72470 : + Rational-71627 -> + a-72469 -> + a-72469) + (n-72471 : + a-72469) -> + c-72470 + (unsafeRatio-71648 + 1 1) - n) - (\(ds : - Rational) - (ds : - List - Rational) -> - Cons - {Rational} - ds - ds) - (Nil - {Rational}))) - n))))) - n)))))))))))))))))))))))))))))) - !fun : List (Tuple2 data data) -> Bool - = (let - a = Tuple2 data data - in - \(f : a -> Bool) -> - letrec - !go : List a -> Bool - = \(ds : List a) -> - List_match - {a} - ds - {all dead. Bool} - (/\dead -> True) - (\(x : a) (xs : List a) -> - /\dead -> - Bool_match - (f x) - {all dead. Bool} - (/\dead -> go xs) - (/\dead -> False) - {all dead. dead}) - {all dead. dead} - in - \(eta : List a) -> go eta) - (\(ds : Tuple2 data data) -> - Tuple2_match - {data} - {data} - ds - {Bool} - (\(ds : data) (actualValueData : data) -> - validateParamValue - ((let - !k : integer = unIData ds - in - letrec - !go : List (Tuple2 integer ParamValue) -> ParamValue - = \(ds : List (Tuple2 integer ParamValue)) -> - List_match - {Tuple2 integer ParamValue} - ds - {all dead. ParamValue} - (/\dead -> error {ParamValue}) - (\(ds : Tuple2 integer ParamValue) - (xs' : List (Tuple2 integer ParamValue)) -> - /\dead -> - Tuple2_match - {integer} - {ParamValue} - ds - {ParamValue} - (\(k' : integer) (i : ParamValue) -> - Bool_match - (equalsInteger k k') - {all dead. ParamValue} - (/\dead -> i) - (/\dead -> go xs') - {all dead. dead})) - {all dead. dead} - in - go) - cfg) - actualValueData)) - in - \(ds : data) -> - Maybe_match - {List (Tuple2 data data)} - (let - !ds : data - = headList + (c-72470 + (unsafeRatio-71648 + 4 + 5) + n-72471)) + (\(ds-72472 : + Rational-71627) + (ds-72473 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72472 + ds-72473) + (Nil-71589 + {Rational-71627}))) + n-72463)))) + (c-72382 + (ParamRational-71634 + ((let + a-72474 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72475 : + all b-72476. + (a-72474 -> + b-72476 -> + b-72476) -> + b-72476 -> + b-72476) -> + g-72475 + {List-71588 + a-72474} + (\(ds-72477 : + a-72474) + (ds-72478 : + List-71588 + a-72474) -> + Cons-71590 + {a-72474} + ds-72477 + ds-72478) + (Nil-71589 + {a-72474})) + (/\a-72479 -> + \(c-72480 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72479 -> + a-72479) + (n-72481 : + a-72479) -> + c-72480 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72482 + = List-71588 + Rational-71627 + in + \(c-72483 : + Rational-71627 -> + a-72482 -> + a-72482) + (n-72484 : + a-72482) -> + c-72483 + (unsafeRatio-71648 + 1 + 2) + (c-72483 + (unsafeRatio-71648 + 51 + 100) + n-72484)) + (\(ds-72485 : + Rational-71627) + (ds-72486 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72485 + ds-72486) + (Nil-71589 + {Rational-71627}))) + (c-72480 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72487 + = List-71588 + Rational-71627 + in + \(c-72488 : + Rational-71627 -> + a-72487 -> + a-72487) + (n-72489 : + a-72487) -> + c-72488 + (unsafeRatio-71648 + 1 + 1) + (c-72488 + (unsafeRatio-71648 + 3 + 4) + n-72489)) + (\(ds-72490 : + Rational-71627) + (ds-72491 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72490 + ds-72491) + (Nil-71589 + {Rational-71627}))) + n-72481)))) + (c-72382 + (ParamRational-71634 + ((let + a-72492 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72493 : + all b-72494. + (a-72492 -> + b-72494 -> + b-72494) -> + b-72494 -> + b-72494) -> + g-72493 + {List-71588 + a-72492} + (\(ds-72495 : + a-72492) + (ds-72496 : + List-71588 + a-72492) -> + Cons-71590 + {a-72492} + ds-72495 + ds-72496) + (Nil-71589 + {a-72492})) + (/\a-72497 -> + \(c-72498 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72497 -> + a-72497) + (n-72499 : + a-72497) -> + c-72498 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72500 + = List-71588 + Rational-71627 + in + \(c-72501 : + Rational-71627 -> + a-72500 -> + a-72500) + (n-72502 : + a-72500) -> + c-72501 + (unsafeRatio-71648 + 1 + 2) + (c-72501 + (unsafeRatio-71648 + 51 + 100) + n-72502)) + (\(ds-72503 : + Rational-71627) + (ds-72504 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72503 + ds-72504) + (Nil-71589 + {Rational-71627}))) + (c-72498 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72505 + = List-71588 + Rational-71627 + in + \(c-72506 : + Rational-71627 -> + a-72505 -> + a-72505) + (n-72507 : + a-72505) -> + c-72506 + (unsafeRatio-71648 + 1 + 1) + (c-72506 + (unsafeRatio-71648 + 3 + 4) + n-72507)) + (\(ds-72508 : + Rational-71627) + (ds-72509 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72508 + ds-72509) + (Nil-71589 + {Rational-71627}))) + n-72499)))) + (c-72382 + (ParamRational-71634 + ((let + a-72510 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72511 : + all b-72512. + (a-72510 -> + b-72512 -> + b-72512) -> + b-72512 -> + b-72512) -> + g-72511 + {List-71588 + a-72510} + (\(ds-72513 : + a-72510) + (ds-72514 : + List-71588 + a-72510) -> + Cons-71590 + {a-72510} + ds-72513 + ds-72514) + (Nil-71589 + {a-72510})) + (/\a-72515 -> + \(c-72516 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72515 -> + a-72515) + (n-72517 : + a-72515) -> + c-72516 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72518 + = List-71588 + Rational-71627 + in + \(c-72519 : + Rational-71627 -> + a-72518 -> + a-72518) + (n-72520 : + a-72518) -> + c-72519 + (unsafeRatio-71648 + 1 + 2) + (c-72519 + (unsafeRatio-71648 + 51 + 100) + n-72520)) + (\(ds-72521 : + Rational-71627) + (ds-72522 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72521 + ds-72522) + (Nil-71589 + {Rational-71627}))) + (c-72516 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72523 + = List-71588 + Rational-71627 + in + \(c-72524 : + Rational-71627 -> + a-72523 -> + a-72523) + (n-72525 : + a-72523) -> + c-72524 + (unsafeRatio-71648 + 1 + 1) + (c-72524 + (unsafeRatio-71648 + 3 + 4) + n-72525)) + (\(ds-72526 : + Rational-71627) + (ds-72527 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72526 + ds-72527) + (Nil-71589 + {Rational-71627}))) + n-72517)))) + (c-72382 + (ParamRational-71634 + ((let + a-72528 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72529 : + all b-72530. + (a-72528 -> + b-72530 -> + b-72530) -> + b-72530 -> + b-72530) -> + g-72529 + {List-71588 + a-72528} + (\(ds-72531 : + a-72528) + (ds-72532 : + List-71588 + a-72528) -> + Cons-71590 + {a-72528} + ds-72531 + ds-72532) + (Nil-71589 + {a-72528})) + (/\a-72533 -> + \(c-72534 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72533 -> + a-72533) + (n-72535 : + a-72533) -> + c-72534 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72536 + = List-71588 + Rational-71627 + in + \(c-72537 : + Rational-71627 -> + a-72536 -> + a-72536) + (n-72538 : + a-72536) -> + c-72537 + (unsafeRatio-71648 + 1 + 2) + (c-72537 + (unsafeRatio-71648 + 3 + 4) + n-72538)) + (\(ds-72539 : + Rational-71627) + (ds-72540 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72539 + ds-72540) + (Nil-71589 + {Rational-71627}))) + (c-72534 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72541 + = List-71588 + Rational-71627 + in + \(c-72542 : + Rational-71627 -> + a-72541 -> + a-72541) + (n-72543 : + a-72541) -> + c-72542 + (unsafeRatio-71648 + 1 + 1) + (c-72542 + (unsafeRatio-71648 + 9 + 10) + n-72543)) + (\(ds-72544 : + Rational-71627) + (ds-72545 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72544 + ds-72545) + (Nil-71589 + {Rational-71627}))) + n-72535)))) + (c-72382 + (ParamRational-71634 + ((let + a-72546 + = Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) + in + \(g-72547 : + all b-72548. + (a-72546 -> + b-72548 -> + b-72548) -> + b-72548 -> + b-72548) -> + g-72547 + {List-71588 + a-72546} + (\(ds-72549 : + a-72546) + (ds-72550 : + List-71588 + a-72546) -> + Cons-71590 + {a-72546} + ds-72549 + ds-72550) + (Nil-71589 + {a-72546})) + (/\a-72551 -> + \(c-72552 : + Tuple2-71593 + PredKey-71612 + (List-71588 + Rational-71627) -> + a-72551 -> + a-72551) + (n-72553 : + a-72551) -> + c-72552 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MinValue-71614 + ((let + a-72554 + = List-71588 + Rational-71627 + in + \(c-72555 : + Rational-71627 -> + a-72554 -> + a-72554) + (n-72556 : + a-72554) -> + c-72555 + (unsafeRatio-71648 + 1 + 2) + n-72556) + (\(ds-72557 : + Rational-71627) + (ds-72558 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72557 + ds-72558) + (Nil-71589 + {Rational-71627}))) + (c-72552 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + Rational-71627} + MaxValue-71613 + ((let + a-72559 + = List-71588 + Rational-71627 + in + \(c-72560 : + Rational-71627 -> + a-72559 -> + a-72559) + (n-72561 : + a-72559) -> + c-72560 + (unsafeRatio-71648 + 1 + 1) + n-72561) + (\(ds-72562 : + Rational-71627) + (ds-72563 : + List-71588 + Rational-71627) -> + Cons-71590 + {Rational-71627} + ds-72562 + ds-72563) + (Nil-71589 + {Rational-71627}))) + n-72553)))) + n-72383)))))))))) + (\(ds-72564 : + ParamValue-71630) + (ds-72565 : + List-71588 + ParamValue-71630) -> + Cons-71590 + {ParamValue-71630} + ds-72564 + ds-72565) + (Nil-71589 + {ParamValue-71630})))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 27 + (ParamInteger-71632 + ((let + a-72566 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72567 : + all b-72568. + (a-72566 -> + b-72568 -> + b-72568) -> + b-72568 -> + b-72568) -> + g-72567 + {List-71588 + a-72566} + (\(ds-72569 : + a-72566) + (ds-72570 : + List-71588 + a-72566) -> + Cons-71590 + {a-72566} + ds-72569 + ds-72570) + (Nil-71589 + {a-72566})) + (/\a-72571 -> + \(c-72572 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72571 -> + a-72571) + (n-72573 : + a-72571) -> + c-72572 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72574 + = List-71588 + integer + in + \(c-72575 : + integer -> + a-72574 -> + a-72574) + (n-72576 : + a-72574) -> + c-72575 + 0 + (c-72575 + 3 + n-72576)) + (\(ds-72577 : + integer) + (ds-72578 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72577 + ds-72578) + (Nil-71589 + {integer}))) + (c-72572 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72579 + = List-71588 + integer + in + \(c-72580 : + integer -> + a-72579 -> + a-72579) + (n-72581 : + a-72579) -> + c-72580 + 10 + n-72581) + (\(ds-72582 : + integer) + (ds-72583 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72582 + ds-72583) + (Nil-71589 + {integer}))) + n-72573))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 28 + (ParamInteger-71632 + ((let + a-72584 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72585 : + all b-72586. + (a-72584 -> + b-72586 -> + b-72586) -> + b-72586 -> + b-72586) -> + g-72585 + {List-71588 + a-72584} + (\(ds-72587 : + a-72584) + (ds-72588 : + List-71588 + a-72584) -> + Cons-71590 + {a-72584} + ds-72587 + ds-72588) + (Nil-71589 + {a-72584})) + (/\a-72589 -> + \(c-72590 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72589 -> + a-72589) + (n-72591 : + a-72589) -> + c-72590 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72592 + = List-71588 + integer + in + \(c-72593 : + integer -> + a-72592 -> + a-72592) + (n-72594 : + a-72592) -> + c-72593 + 0 + (c-72593 + 18 + n-72594)) + (\(ds-72595 : + integer) + (ds-72596 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72595 + ds-72596) + (Nil-71589 + {integer}))) + (c-72590 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72597 + = List-71588 + integer + in + \(c-72598 : + integer -> + a-72597 -> + a-72597) + (n-72599 : + a-72597) -> + c-72598 + 293 + n-72599) + (\(ds-72600 : + integer) + (ds-72601 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72600 + ds-72601) + (Nil-71589 + {integer}))) + (c-72590 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + NotEqual-71615 + ((let + a-72602 + = List-71588 + integer + in + \(c-72603 : + integer -> + a-72602 -> + a-72602) + (n-72604 : + a-72602) -> + c-72603 + 0 + n-72604) + (\(ds-72605 : + integer) + (ds-72606 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72605 + ds-72606) + (Nil-71589 + {integer}))) + n-72591)))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 29 + (ParamInteger-71632 + ((let + a-72607 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72608 : + all b-72609. + (a-72607 -> + b-72609 -> + b-72609) -> + b-72609 -> + b-72609) -> + g-72608 + {List-71588 + a-72607} + (\(ds-72610 : + a-72607) + (ds-72611 : + List-71588 + a-72607) -> + Cons-71590 + {a-72607} + ds-72610 + ds-72611) + (Nil-71589 + {a-72607})) + (/\a-72612 -> + \(c-72613 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72612 -> + a-72612) + (n-72614 : + a-72612) -> + c-72613 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72615 + = List-71588 + integer + in + \(c-72616 : + integer -> + a-72615 -> + a-72615) + (n-72617 : + a-72615) -> + c-72616 + 1 + n-72617) + (\(ds-72618 : + integer) + (ds-72619 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72618 + ds-72619) + (Nil-71589 + {integer}))) + (c-72613 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72620 + = List-71588 + integer + in + \(c-72621 : + integer -> + a-72620 -> + a-72620) + (n-72622 : + a-72620) -> + c-72621 + 15 + n-72622) + (\(ds-72623 : + integer) + (ds-72624 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72623 + ds-72624) + (Nil-71589 + {integer}))) + n-72614))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 30 + (ParamInteger-71632 + ((let + a-72625 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72626 : + all b-72627. + (a-72625 -> + b-72627 -> + b-72627) -> + b-72627 -> + b-72627) -> + g-72626 + {List-71588 + a-72625} + (\(ds-72628 : + a-72625) + (ds-72629 : + List-71588 + a-72625) -> + Cons-71590 + {a-72625} + ds-72628 + ds-72629) + (Nil-71589 + {a-72625})) + (/\a-72630 -> + \(c-72631 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72630 -> + a-72630) + (n-72632 : + a-72630) -> + c-72631 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72633 + = List-71588 + integer + in + \(c-72634 : + integer -> + a-72633 -> + a-72633) + (n-72635 : + a-72633) -> + c-72634 + 0 + (c-72634 + 1000000 + n-72635)) + (\(ds-72636 : + integer) + (ds-72637 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72636 + ds-72637) + (Nil-71589 + {integer}))) + (c-72631 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72638 + = List-71588 + integer + in + \(c-72639 : + integer -> + a-72638 -> + a-72638) + (n-72640 : + a-72638) -> + c-72639 + 10000000000000 + n-72640) + (\(ds-72641 : + integer) + (ds-72642 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72641 + ds-72642) + (Nil-71589 + {integer}))) + n-72632))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 31 + (ParamInteger-71632 + ((let + a-72643 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72644 : + all b-72645. + (a-72643 -> + b-72645 -> + b-72645) -> + b-72645 -> + b-72645) -> + g-72644 + {List-71588 + a-72643} + (\(ds-72646 : + a-72643) + (ds-72647 : + List-71588 + a-72643) -> + Cons-71590 + {a-72643} + ds-72646 + ds-72647) + (Nil-71589 + {a-72643})) + (/\a-72648 -> + \(c-72649 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72648 -> + a-72648) + (n-72650 : + a-72648) -> + c-72649 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72651 + = List-71588 + integer + in + \(c-72652 : + integer -> + a-72651 -> + a-72651) + (n-72653 : + a-72651) -> + c-72652 + 0 + (c-72652 + 1000000 + n-72653)) + (\(ds-72654 : + integer) + (ds-72655 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72654 + ds-72655) + (Nil-71589 + {integer}))) + (c-72649 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72656 + = List-71588 + integer + in + \(c-72657 : + integer -> + a-72656 -> + a-72656) + (n-72658 : + a-72656) -> + c-72657 + 100000000000 + n-72658) + (\(ds-72659 : + integer) + (ds-72660 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72659 + ds-72660) + (Nil-71589 + {integer}))) + n-72650))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 32 + (ParamInteger-71632 + ((let + a-72661 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72662 : + all b-72663. + (a-72661 -> + b-72663 -> + b-72663) -> + b-72663 -> + b-72663) -> + g-72662 + {List-71588 + a-72661} + (\(ds-72664 : + a-72661) + (ds-72665 : + List-71588 + a-72661) -> + Cons-71590 + {a-72661} + ds-72664 + ds-72665) + (Nil-71589 + {a-72661})) + (/\a-72666 -> + \(c-72667 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72666 -> + a-72666) + (n-72668 : + a-72666) -> + c-72667 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72669 + = List-71588 + integer + in + \(c-72670 : + integer -> + a-72669 -> + a-72669) + (n-72671 : + a-72669) -> + c-72670 + 13 + (c-72670 + 0 + n-72671)) + (\(ds-72672 : + integer) + (ds-72673 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72672 + ds-72673) + (Nil-71589 + {integer}))) + (c-72667 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72674 + = List-71588 + integer + in + \(c-72675 : + integer -> + a-72674 -> + a-72674) + (n-72676 : + a-72674) -> + c-72675 + 37 + n-72676) + (\(ds-72677 : + integer) + (ds-72678 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72677 + ds-72678) + (Nil-71589 + {integer}))) + n-72668))))) + (c-71850 + (Tuple2-71594 + {integer} + {ParamValue-71630} + 33 + (ParamInteger-71632 + ((let + a-72679 + = Tuple2-71593 + PredKey-71612 + (List-71588 + integer) + in + \(g-72680 : + all b-72681. + (a-72679 -> + b-72681 -> + b-72681) -> + b-72681 -> + b-72681) -> + g-72680 + {List-71588 + a-72679} + (\(ds-72682 : + a-72679) + (ds-72683 : + List-71588 + a-72679) -> + Cons-71590 + {a-72679} + ds-72682 + ds-72683) + (Nil-71589 + {a-72679})) + (/\a-72684 -> + \(c-72685 : + Tuple2-71593 + PredKey-71612 + (List-71588 + integer) -> + a-72684 -> + a-72684) + (n-72686 : + a-72684) -> + c-72685 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MinValue-71614 + ((let + a-72687 + = List-71588 + integer + in + \(c-72688 : + integer -> + a-72687 -> + a-72687) + (n-72689 : + a-72687) -> + c-72688 + 0 + n-72689) + (\(ds-72690 : + integer) + (ds-72691 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72690 + ds-72691) + (Nil-71589 + {integer}))) + (c-72685 + (Tuple2-71594 + {PredKey-71612} + {List-71588 + integer} + MaxValue-71613 + ((let + a-72692 + = List-71588 + integer + in + \(c-72693 : + integer -> + a-72692 -> + a-72692) + (n-72694 : + a-72692) -> + c-72693 + 1000 + n-72694) + (\(ds-72695 : + integer) + (ds-72696 : + List-71588 + integer) -> + Cons-71590 + {integer} + ds-72695 + ds-72696) + (Nil-71589 + {integer}))) + n-72686))))) + n-71851)))))))))))))))))))))))))))))) + !fun-72731 : List-71588 (Tuple2-71593 data data) -> Bool-71608 + = (let + a-72698 = Tuple2-71593 data data + in + \(f-72699 : a-72698 -> Bool-71608) -> + letrec + !go-72701 : List-71588 a-72698 -> Bool-71608 + = \(ds-72702 : List-71588 a-72698) -> + List_match-71591 + {a-72698} + ds-72702 + {all dead-72703. Bool-71608} + (/\dead-72704 -> True-71609) + (\(x-72705 : a-72698) (xs-72706 : List-71588 a-72698) -> + /\dead-72707 -> + Bool_match-71611 + (f-72699 x-72705) + {all dead-72708. Bool-71608} + (/\dead-72709 -> go-72701 xs-72706) + (/\dead-72710 -> False-71610) + {all dead-72711. dead-72711}) + {all dead-72712. dead-72712} + in + \(eta-72700 : List-71588 a-72698) -> go-72701 eta-72700) + (\(ds-72713 : Tuple2-71593 data data) -> + Tuple2_match-71595 {data} - (tailList - {data} - (tailList - {data} - (sndPair - {integer} - {list data} - (unConstrData - (let - !ds : data - = headList - {data} - (tailList - {data} - (tailList - {data} - (sndPair - {integer} - {list data} - (unConstrData ds)))) - ~si : pair integer (list data) = unConstrData ds - in - Bool_match - (ifThenElse - {Bool} - (equalsInteger - 5 - (fstPair {integer} {list data} si)) - True - False) - {all dead. data} - (/\dead -> - headList + {data} + ds-72713 + {Bool-71608} + (\(ds-72714 : data) (actualValueData-72715 : data) -> + validateParamValue-71678 + (let + !k-72716 : integer = unIData ds-72714 + in + letrec + !go-72717 : + List-71588 (Tuple2-71593 integer ParamValue-71630) -> + ParamValue-71630 + = \(ds-72718 : + List-71588 + (Tuple2-71593 integer ParamValue-71630)) -> + List_match-71591 + {Tuple2-71593 integer ParamValue-71630} + ds-72718 + {all dead-72719. ParamValue-71630} + (/\dead-72720 -> error {ParamValue-71630}) + (\(ds-72721 : + Tuple2-71593 integer ParamValue-71630) + (xs'-72722 : + List-71588 + (Tuple2-71593 integer ParamValue-71630)) -> + /\dead-72723 -> + Tuple2_match-71595 + {integer} + {ParamValue-71630} + ds-72721 + {ParamValue-71630} + (\(k'-72724 : integer) + (i-72725 : ParamValue-71630) -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (equalsInteger k-72716 k'-72724) + True-71609 + False-71610) + {all dead-72726. ParamValue-71630} + (/\dead-72727 -> i-72725) + (/\dead-72728 -> go-72717 xs'-72722) + {all dead-72729. dead-72729})) + {all dead-72730. dead-72730} + in + go-72717 cfg-72697) + actualValueData-72715)) + in + \(ds-72732 : data) -> + Maybe_match-71606 + {List-71588 (Tuple2-71593 data data)} + (let + !ds-72739 : data + = headList + {data} + (tailList + {data} + (tailList + {data} + (sndPair + {integer} + {list data} + (unConstrData + (let + !ds-72733 : data + = headList {data} (tailList {data} - (sndPair {integer} {list data} si))) - (/\dead -> error {data}) - {all dead. dead}))))) - ~ds : pair integer (list data) = unConstrData ds - !x : integer = fstPair {integer} {list data} ds - in - Bool_match - (ifThenElse {Bool} (equalsInteger 0 x) True False) - {all dead. Maybe (List (Tuple2 data data))} - (/\dead -> - Just - {List (Tuple2 data data)} - (go - (unMapData - (headList - {data} - (tailList {data} (sndPair {integer} {list data} ds)))))) - (/\dead -> - Bool_match - (ifThenElse {Bool} (equalsInteger 2 x) True False) - {all dead. Maybe (List (Tuple2 data data))} - (/\dead -> Nothing {List (Tuple2 data data)}) - (/\dead -> error {Maybe (List (Tuple2 data data))}) - {all dead. dead}) - {all dead. dead}) - {all dead. unit} - (\(cparams : List (Tuple2 data data)) -> - /\dead -> - Bool_match - (fun cparams) - {all dead. unit} - (/\dead -> ()) - (/\dead -> error {unit}) - {all dead. dead}) - (/\dead -> ()) - {all dead. dead})) \ No newline at end of file + (tailList + {data} + (sndPair + {integer} + {list data} + (unConstrData ds-72732)))) + ~si-72734 : pair integer (list data) + = unConstrData ds-72733 + in + Bool_match-71611 + (ifThenElse + {Bool-71608} + (equalsInteger + 5 + (fstPair {integer} {list data} si-72734)) + True-71609 + False-71610) + {all dead-72735. data} + (/\dead-72736 -> + headList + {data} + (tailList + {data} + (sndPair {integer} {list data} si-72734))) + (/\dead-72737 -> error {data}) + {all dead-72738. dead-72738}))))) + ~ds-72740 : pair integer (list data) = unConstrData ds-72739 + !x-72741 : integer = fstPair {integer} {list data} ds-72740 + in + Bool_match-71611 + (ifThenElse + {Bool-71608} + (equalsInteger 0 x-72741) + True-71609 + False-71610) + {all dead-72742. Maybe-71603 (List-71588 (Tuple2-71593 data data))} + (/\dead-72743 -> + Just-71604 + {List-71588 (Tuple2-71593 data data)} + (go-71598 + (unMapData + (headList + {data} + (tailList + {data} + (sndPair {integer} {list data} ds-72740)))))) + (/\dead-72744 -> + Bool_match-71611 + (ifThenElse + {Bool-71608} + (equalsInteger 2 x-72741) + True-71609 + False-71610) + {all dead-72745. Maybe-71603 (List-71588 (Tuple2-71593 data data))} + (/\dead-72746 -> + Nothing-71605 {List-71588 (Tuple2-71593 data data)}) + (/\dead-72747 -> + error {Maybe-71603 (List-71588 (Tuple2-71593 data data))}) + {all dead-72748. dead-72748}) + {all dead-72749. dead-72749}) + {all dead-72750. unit} + (\(cparams-72751 : List-71588 (Tuple2-71593 data data)) -> + /\dead-72752 -> + Bool_match-71611 + (fun-72731 cparams-72751) + {all dead-72753. unit} + (/\dead-72754 -> ()) + (/\dead-72755 -> error {unit}) + {all dead-72756. dead-72756}) + (/\dead-72757 -> ()) + {all dead-72758. dead-72758}) diff --git a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden index f8aa16528b0..e1031553ca9 100644 --- a/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden +++ b/cardano-constitution/test/Cardano/Constitution/Validator/GoldenTests/unsorted.uplc.golden @@ -1,1416 +1,1395 @@ -(program - 1.1.0 - ((\fix1 -> - (\`$fOrdRational0_$c<=` -> - (\`$fOrdInteger_$ccompare` -> - (\equalsInteger -> - (\validatePreds -> - (\euclid -> - (\unsafeRatio -> - (\cse -> - (\validateParamValue -> - (\validateParamValues -> - (\go -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cse -> - (\cfg -> - (\fun - ds -> - force - (case - ((\cse -> - (\x -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - x) - (delay - (delay - (constr 0 - [ (go - (unMapData - (force - headList +program + 1.1.0 + ((\fix1!0 -> + (\`$fOrdRational0_$c<=`!0 -> + (\`$fOrdInteger_$ccompare`!0 -> + (\validatePreds!0 -> + (\euclid!0 -> + (\unsafeRatio!0 -> + (\cse!0 -> + (\validateParamValue!0 -> + (\validateParamValues!0 -> + (\go!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cse!0 -> + (\cfg!0 -> + (\fun!0 + ds!0 -> + force + (case + ((\cse!0 -> + (\x!0 -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + x!1) + (delay + (delay + (constr 0 + [ (go!38 + (unMapData + (force + headList + (force + tailList + (force + (force + sndPair) + cse!2))))) ]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 2 + x!1) + (delay + (delay + (constr 1 + [ ]))) + (delay + (delay + error)))))))))) + (force + (force + fstPair) + cse!1)) + (unConstrData + (force + headList + (force + tailList + (force + tailList + (force + (force + sndPair) + (unConstrData + ((\cse!0 -> + force + (force + (force + ifThenElse + (equalsInteger + 5 (force - tailList (force + fstPair) + cse!1)) + (delay + (delay + (force + headList (force - sndPair) - cse))))) ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - error)))))))))) - (force - (force - fstPair) - cse)) - (unConstrData + tailList + (force + (force + sndPair) + cse!1))))) + (delay + (delay + error))))) + (unConstrData + (force + headList + (force + tailList + (force + tailList + (force + (force + sndPair) + (unConstrData + ds!1)))))))))))))) + [ (\cparams!0 -> + delay (force - headList - (force - tailList - (force - tailList - (force - (force - sndPair) - (unConstrData - ((\cse -> - force - (force - (force - ifThenElse - (equalsInteger - 5 - (force - (force - fstPair) - cse)) - (delay - (delay - (force - headList - (force - tailList - (force - (force - sndPair) - cse))))) - (delay - (delay - error))))) - (unConstrData - (force - headList - (force - tailList - (force - tailList - (force - (force - sndPair) - (unConstrData - ds)))))))))))))) - [ (\cparams -> - delay - (force - (case - (fun - cparams) - [ (delay - ()) - , (delay - error) ]))) - , (delay - ()) ])) - ((\go - eta -> - go - eta) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay - (constr 0 - [ ])) - , (\x - xs -> - delay - (force - (case - (case - x - [ (\ds - actualValueData -> - validateParamValue - ((\k -> - fix1 - (\go - ds -> - force - (case - ds - [ (delay - error) - , (\ds - xs' -> - delay - (case - ds - [ (\k' - i -> - force - (case - (equalsInteger - k - k') - [ (delay - i) - , (delay - (go - xs')) ])) ])) ]))) - (unIData - ds) - cfg) - actualValueData) ]) - [ (delay - (go - xs)) - , (delay - (constr 1 - [ ])) ]))) ]))))) - (constr 1 - [ (constr 0 - [ 0 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 30 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 1000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 1 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 2 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 24576 - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 122880 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 3 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 32768 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 4 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 5 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1000000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 5000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 6 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250000000 - , cse ]) ]) - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 7 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 8 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 250 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 2000 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 9 - , (constr 3 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 10 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 1000) - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 200) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 11 - , (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 16 - , (constr 1 - [ (constr 1 - [ cse - , cse ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 17 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 3000 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 6500 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 18 - , (constr 0 - [ ]) ]) - , (constr 1 - [ (constr 0 - [ 19 - , (constr 2 - [ (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 25) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 20000) - , (constr 0 - [ ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (cse - 5000) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 20 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 21 - , (constr 2 - [ (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 120000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 40000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 22 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 12288 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 23 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 100 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 200 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 24 - , (constr 1 - [ (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 25 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , cse ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 26 - , (constr 2 - [ (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 1 - [ (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , cse ]) ]) - , cse ]) ]) - , cse ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 27 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 3 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 28 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 - , (constr 1 - [ 18 - , (constr 0 - [ ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 293 - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 29 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 15 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 30 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 10000000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 31 - , (constr 1 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 100000000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 32 - , (constr 1 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 13 - , cse ]) ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ 37 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 1 - [ (constr 0 - [ 33 - , (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , cse ]) - , (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ (unsafeRatio - 1000 - 1) - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , cse ]) ])) - (constr 3 - [ (constr 1 - [ cse + (case + (fun!3 + cparams!1) + [ (delay + ()) + , (delay + error) ]))) + , (delay + ()) ])) + ((\go!0 + eta!0 -> + go!2 + eta!1) + (fix1!43 + (\go!0 + ds!0 -> + force + (case + ds!1 + [ (delay + (constr 0 + [ ])) + , (\x!0 + xs!0 -> + delay + (force + (case + (case + x!2 + [ (\ds!0 + actualValueData!0 -> + validateParamValue!42 + ((\k!0 -> + fix1!50 + (\go!0 + ds!0 -> + force + (case + ds!1 + [ (delay + error) + , (\ds!0 + xs'!0 -> + delay + (case + ds!2 + [ (\k'!0 + i!0 -> + force + (force + (force + ifThenElse + (equalsInteger + k!7 + k'!2) + (delay + (delay + i!1)) + (delay + (delay + (go!6 + xs'!3)))))) ])) ])) + cfg!8) + (unIData + ds!2)) + actualValueData!1) ]) + [ (delay + (go!4 + xs!1)) + , (delay + (constr 1 + [ ])) ]))) ]))))) + (constr 1 + [ (constr 0 + [ 0 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 30 + , cse!31 ]) ]) + , cse!13 ]) ]) ]) , (constr 1 [ (constr 0 + [ 1 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100000 + , cse!31 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 [ (constr 0 - [ ]) + [ 2 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 24576 + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 122880 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) , (constr 1 - [ cse - , cse ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 3 - [ (constr 1 - [ cse - , (constr 1 - [ (constr 0 + [ (constr 0 + [ 3 + , (constr 1 + [ (constr 1 + [ cse!19 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 32768 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 4 + , (constr 1 + [ (constr 1 + [ cse!19 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 5 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 1000000 + , cse!31 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 5000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 6 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250000000 + , cse!31 ]) ]) + , cse!11 ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 7 + , (constr 1 + [ (constr 1 + [ cse!19 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 8 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 250 + , cse!31 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 2000 + , (constr 0 + [ ]) ]) ]) + , cse!10 ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 9 + , (constr 3 + [ (constr 1 + [ cse!7 + , cse!8 ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 10 + , (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse!28 + 1000) + , cse!12 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse!28 + 200) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 11 + , (constr 3 + [ (constr 1 + [ cse!7 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse!27 + 10) + , cse!14 ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 16 + , (constr 1 + [ (constr 1 + [ cse!19 + , cse!11 ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 17 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 3000 + , cse!31 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 6500 + , (constr 0 + [ ]) ]) ]) + , cse!10 ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 18 + , (constr 0 + [ ]) ]) + , (constr 1 + [ (constr 0 + [ 19 + , (constr 2 + [ (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse!28 + 25) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse!28 + 5) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ (cse!28 + 20000) + , (constr 0 + [ ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ (cse!28 + 5000) + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 20 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse!19 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse!19 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 21 + , (constr 2 + [ (constr 1 + [ (constr 1 + [ (constr 1 + [ cse!19 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 120000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 1 + [ (constr 1 + [ cse!19 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 40000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 22 + , (constr 1 + [ (constr 1 + [ cse!19 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 12288 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 23 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 100 + , cse!31 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 200 + , (constr 0 + [ ]) ]) ]) + , cse!10 ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 24 + , (constr 1 + [ (constr 1 + [ cse!22 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 25 + , (constr 2 + [ (constr 1 + [ cse!1 + , (constr 1 + [ cse!3 + , (constr 1 + [ cse!3 + , (constr 1 + [ cse!2 + , cse!4 ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 26 + , (constr 2 + [ (constr 1 + [ cse!1 + , (constr 1 + [ cse!3 + , (constr 1 + [ cse!3 + , (constr 1 + [ cse!3 + , (constr 1 + [ cse!2 + , (constr 1 + [ cse!1 + , (constr 1 + [ cse!1 + , (constr 1 + [ cse!1 + , (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse!18 + , cse!15 ]) ]) + , cse!5 ]) ]) + , cse!4 ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 27 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 3 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 28 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 0 + , (constr 1 + [ 18 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 293 + , (constr 0 + [ ]) ]) ]) + , cse!10 ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 29 + , (constr 1 + [ (constr 1 + [ cse!22 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 15 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 30 + , (constr 1 + [ (constr 1 + [ cse!9 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 10000000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 31 + , (constr 1 + [ (constr 1 + [ cse!9 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 100000000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 32 + , (constr 1 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ 13 + , cse!31 ]) ]) + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 37 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) + , (constr 1 + [ (constr 0 + [ 33 + , (constr 1 + [ (constr 1 + [ cse!19 + , cse!13 ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ cse!5 + , (constr 1 [ (constr 0 - [ ]) - , (constr 1 - [ cse + [ (constr 0 + [ ]) , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 3 + [ cse!15 + , cse!14 ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 [ (constr 1 - [ (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) - , cse ]) ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ (cse - 10) - , (constr 0 - [ ]) ]) ]) ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ (cse - 10) - , cse ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ cse - , (constr 1 - [ cse - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 + [ cse!4 + , (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse!14 + , (constr 1 + [ cse!21 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ]) ]) ])) + (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse!15 + , (constr 1 + [ cse!21 + , (constr 0 + [ ]) ]) ]) ]) + , cse!2 ]) ])) + (constr 1 + [ (constr 3 + [ (constr 1 + [ (constr 0 + [ (constr 1 + [ ]) + , (constr 1 + [ cse!14 + , (constr 0 + [ ]) ]) ]) + , cse!4 ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ cse!11 + , (constr 1 + [ cse!12 + , (constr 0 + [ ]) ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 0 + , (constr 1 + [ cse!12 + , (constr 1 + [ cse!14 + , (constr 0 + [ ]) ]) ]) ])) + (constr 0 + [ (constr 1 + [ ]) , (constr 1 - [ 1000000 - , (constr 0 - [ ]) ]) ]) ])) - (constr 1 - [ (constr 0 - [ (constr 2 - [ ]) - , cse ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ (constr 0 - [ (constr 0 + [ cse!14 + , cse!5 ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , cse!6 ]) + , (constr 0 + [ ]) ])) + (constr 0 + [ (constr 1 [ ]) , (constr 1 - [ 500000000 - , (constr 0 - [ ]) ]) ]) - , (constr 0 - [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) - (constr 1 - [ cse - , (constr 0 - [ ]) ])) - (cse - 1)) - (constr 0 - [ (constr 1 - [ ]) - , cse ])) - (cse - 100)) - (cse - 2)) - (cse - 20)) - (constr 0 - [ (constr 1 - [ ]) - , (constr 1 - [ 1 - , (constr 0 - [ ]) ]) ])) - (cse 4)) - (cse 5)) - (cse 1)) - (unsafeRatio 9)) - (unsafeRatio 0)) - (unsafeRatio 3)) - (unsafeRatio 4)) - (unsafeRatio 13)) - (constr 1 [0, (constr 0 [])])) - (unsafeRatio 51)) - (unsafeRatio 1)) - (fix1 - (\go l -> - force (force chooseList) - l - (\ds -> constr 0 []) - (\ds -> - constr 1 - [ ((\p -> - constr 0 - [ (force - (force fstPair) - p) - , (force - (force sndPair) - p) ]) - (force headList l)) - , (go (force tailList l)) ]) - ()))) - (cse (\arg_0 arg_1 -> arg_1))) - (cse (\arg_0 arg_1 -> arg_0))) - (force - ((\s -> s s) - (\s h -> - delay - (\fr -> - (\k -> - fr - (\x -> k (\f_0 f_1 -> f_0 x)) - (\x -> k (\f_0 f_1 -> f_1 x))) - (\fq -> force (s s h) (force h fq)))) - (delay - (\choose - validateParamValue - validateParamValues -> - choose - (\eta eta -> - force - (case - eta - [ (delay (constr 0 [])) - , (\preds -> - delay - (validatePreds - (constr 0 - [ equalsInteger - , `$fOrdInteger_$ccompare` - , (\x y -> - force - ifThenElse - (lessThanInteger - x - y) - (constr 0 - []) - (constr 1 - [])) - , (\x y -> - force - ifThenElse - (lessThanEqualsInteger - x - y) - (constr 0 - []) - (constr 1 - [])) - , (\x y -> - force - ifThenElse - (lessThanEqualsInteger - x - y) - (constr 1 - []) - (constr 0 - [])) - , (\x y -> - force - ifThenElse - (lessThanInteger - x - y) - (constr 1 - []) - (constr 0 - [])) - , (\x y -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - y)) - (delay - (delay - x))))) - , (\x y -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - x - y) - (delay - (delay - x)) - (delay - (delay - y))))) ]) - preds - (unIData eta))) - , (\paramValues -> - delay - (validateParamValues - paramValues - (unListData eta))) - , (\preds -> - delay - ((\cse -> - validatePreds - (constr 0 - [ (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - (force - (force - ifThenElse - (equalsInteger - n - n') - (delay - (delay - (force - ifThenElse - (equalsInteger - d - d') - (constr 0 - [ ]) + [ 0 + , (constr 1 + [ 1000000 + , (constr 0 + [ ]) ]) ]) ])) (constr 1 - [ ])))) - (delay - (delay + [ (constr 0 + [ (constr 2 + [ ]) + , cse!21 ]) + , (constr 0 + [ ]) ])) (constr 1 - [ ])))))) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - `$fOrdInteger_$ccompare` - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 0 - [ ]) - (constr 1 - [ ])) ]) ]) - , `$fOrdRational0_$c<=` - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanEqualsInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) - (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\ds ds -> - case - ds - [ (\n - d -> - case - ds - [ (\n' - d' -> - force - ifThenElse - (lessThanInteger - (multiplyInteger - n - d') - (multiplyInteger - n' - d)) + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 500000000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ cse!13 + , (constr 0 + [ ]) ])) + (constr 1 + [ (constr 0 + [ (constr 0 + [ ]) + , (constr 1 + [ 1000 + , (constr 0 + [ ]) ]) ]) + , (constr 0 + [ ]) ])) + (constr 1 + [ cse!2 + , (constr 0 + [ ]) ])) (constr 1 - [ ]) - (constr 0 - [ ])) ]) ]) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay - y) - , (delay - x) ])) - , (\x y -> - force - (case - (`$fOrdRational0_$c<=` - x - y) - [ (delay - x) - , (delay - y) ])) ]) - preds - ((\cse -> - force - ifThenElse + [ (cse!12 + 4) + , (constr 0 + [ ]) ])) + (cse!12 + 1)) + (cse!9 + 10)) + (cse!10 + 2)) + (constr 0 + [ (constr 1 + [ ]) + , cse!12 ])) + (cse!12 + 100)) + (cse!7 10)) + (constr 0 + [ (constr 1 + []) + , (constr 1 + [ 1 + , (constr 0 + [ ]) ]) ])) + (cse!6 5)) + (cse!6 20)) + (unsafeRatio!12 0 1)) + (unsafeRatio!11 9)) + (unsafeRatio!10 3)) + (unsafeRatio!9 1)) + (unsafeRatio!8 4)) + (unsafeRatio!7 13)) + (constr 1 [0, (constr 0 [])])) + (unsafeRatio!5 51)) + (fix1!9 + (\go!0 l!0 -> + force (force chooseList) + l!1 + (\ds!0 -> constr 0 []) + (\ds!0 -> + constr 1 + [ ((\p!0 -> + constr 0 + [ (force (force fstPair) + p!1) + , (force (force sndPair) + p!1) ]) + (force headList l!2)) + , (go!3 (force tailList l!2)) ]) + ()))) + (cse!2 (\arg_0!0 arg_1!0 -> arg_1!1))) + (cse!1 (\arg_0!0 arg_1!0 -> arg_0!2))) + (force + ((\s!0 -> s!1 s!1) + (\s!0 h!0 -> + delay + (\fr!0 -> + (\k!0 -> + fr!2 + (\x!0 -> + k!2 (\f_0!0 f_1!0 -> f_0!2 x!3)) + (\x!0 -> + k!2 (\f_0!0 f_1!0 -> f_1!1 x!3))) + (\fq!0 -> + force (s!4 s!4 h!3) + (force h!3 fq!1)))) + (delay + (\choose!0 + validateParamValue!0 + validateParamValues!0 -> + choose!3 + (\eta!0 eta!0 -> + force + (case + eta!2 + [ (delay (constr 0 [])) + , (\preds!0 -> + delay + (validatePreds!9 + (constr 0 + [ (\x!0 y!0 -> + force ifThenElse + (equalsInteger + x!2 + y!1) + (constr 0 []) + (constr 1 [])) + , `$fOrdInteger_$ccompare`!10 + , (\x!0 y!0 -> + force ifThenElse + (lessThanInteger + x!2 + y!1) + (constr 0 []) + (constr 1 [])) + , (\x!0 y!0 -> + force ifThenElse + (lessThanEqualsInteger + x!2 + y!1) + (constr 0 []) + (constr 1 [])) + , (\x!0 y!0 -> + force ifThenElse + (lessThanEqualsInteger + x!2 + y!1) + (constr 1 []) + (constr 0 [])) + , (\x!0 y!0 -> + force ifThenElse + (lessThanInteger + x!2 + y!1) + (constr 1 []) + (constr 0 [])) + , (\x!0 y!0 -> + force + (force (force - nullList - (force - tailList - cse)) - (\ds -> - unsafeRatio - (unIData - (force - headList - cse)) - (unIData - (force - headList - cse)))) - (force tailList - cse) - (\ds -> error) - (constr 0 []))) - (unListData - eta))) ])) - (\ds -> - case - ds - [ (\eta -> - force ifThenElse - (force nullList eta) - (constr 0 []) - (constr 1 [])) - , (\paramValueHd - paramValueTl - actualValueData -> - force - (case - (validateParamValue - paramValueHd - (force headList - actualValueData)) - [ (delay - (validateParamValues - paramValueTl - (force tailList - actualValueData))) - , (delay - (constr 1 - [])) ])) ])))))) - (fix1 - (\unsafeRatio n d -> - force - (force - (force ifThenElse - (equalsInteger 0 d) - (delay (delay error)) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanInteger d 0) - (delay - (delay - (unsafeRatio - (subtractInteger - 0 - n) - (subtractInteger - 0 - d)))) - (delay - (delay - ((\gcd' -> - constr 0 - [ (quotientInteger - n - gcd') - , (quotientInteger - d - gcd') ]) - (euclid - n - d)))))))))))))) - (fix1 - (\euclid x y -> - force - (force - (force ifThenElse - (equalsInteger 0 y) - (delay (delay x)) - (delay - (delay (euclid y (modInteger x y))))))))) - (\`$dOrd` ds ds -> - fix1 - (\go ds -> + ifThenElse + (lessThanEqualsInteger + x!2 + y!1) + (delay + (delay + y!1)) + (delay + (delay + x!2))))) + , (\x!0 y!0 -> + force + (force + (force + ifThenElse + (lessThanEqualsInteger + x!2 + y!1) + (delay + (delay + x!2)) + (delay + (delay + y!1))))) ]) + preds!1 + (unIData eta!2))) + , (\paramValues!0 -> + delay + (validateParamValues!4 + paramValues!1 + (unListData eta!2))) + , (\preds!0 -> + delay + ((\cse!0 -> + validatePreds!10 + (constr 0 + [ (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + force + (force + (force + ifThenElse + (equalsInteger + n!4 + n'!2) + (delay + (delay + (force + ifThenElse + (equalsInteger + d!3 + d'!1) + (constr 0 + [ ]) + (constr 1 + [ ])))) + (delay + (delay + (constr 1 + [ ])))))) ]) ]) + , (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + `$fOrdInteger_$ccompare`!17 + (multiplyInteger + n!4 + d'!1) + (multiplyInteger + n'!2 + d!3)) ]) ]) + , (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n!4 + d'!1) + (multiplyInteger + n'!2 + d!3)) + (constr 0 + [ ]) + (constr 1 + [ ])) ]) ]) + , `$fOrdRational0_$c<=`!12 + , (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + force + ifThenElse + (lessThanEqualsInteger + (multiplyInteger + n!4 + d'!1) + (multiplyInteger + n'!2 + d!3)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 + d!0 -> + case + ds!3 + [ (\n'!0 + d'!0 -> + force + ifThenElse + (lessThanInteger + (multiplyInteger + n!4 + d'!1) + (multiplyInteger + n'!2 + d!3)) + (constr 1 + [ ]) + (constr 0 + [ ])) ]) ]) + , (\x!0 y!0 -> + force + (case + (`$fOrdRational0_$c<=`!14 + x!2 + y!1) + [ (delay + y!1) + , (delay + x!2) ])) + , (\x!0 y!0 -> + force + (case + (`$fOrdRational0_$c<=`!14 + x!2 + y!1) + [ (delay + x!2) + , (delay + y!1) ])) ]) + preds!2 + ((\cse!0 -> + force ifThenElse + (force nullList + (force + tailList + cse!1)) + (\ds!0 -> + unsafeRatio!10 + (unIData + (force + headList + cse!3)) + (unIData + (force + headList + cse!2)))) + (force tailList + cse!1) + (\ds!0 -> error) + (constr 0 []))) + (unListData eta!2))) ])) + (\ds!0 -> + case + ds!1 + [ (\eta!0 -> + force ifThenElse + (force nullList eta!1) + (constr 0 []) + (constr 1 [])) + , (\paramValueHd!0 + paramValueTl!0 + actualValueData!0 -> + force + (case + (validateParamValue!6 + paramValueHd!3 + (force headList + actualValueData!1)) + [ (delay + (validateParamValues!5 + paramValueTl!2 + (force tailList + actualValueData!1))) + , (delay + (constr 1 + [])) ])) ])))))) + (fix1!5 + (\unsafeRatio!0 n!0 d!0 -> force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (case - x - [ (\predKey expectedPredValues -> - (\meaning -> - fix1 - (\go ds -> - force - (case - ds - [ (delay (go xs)) - , (\x xs -> - delay - (force - (case - (meaning - x - ds) - [ (delay - (go - xs)) - , (delay - (constr 1 - [ ])) ]))) ])) - expectedPredValues) - (force - (case - predKey - [ (delay - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ])) - , (delay - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ])) - , (delay - (\x y -> - force - (case - (case - `$dOrd` - [ (\v - v - v - v - v - v - v - v -> - v) ] - x - y) - [ (delay - (constr 1 - [])) - , (delay - (constr 0 - [ ])) ]))) ]))) ])) ])) - ds)) - (\x y -> - force ifThenElse - (equalsInteger x y) - (constr 0 []) - (constr 1 []))) - (\eta eta -> - force - (force - (force ifThenElse - (equalsInteger eta eta) - (delay (delay (constr 0 []))) - (delay - (delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger eta eta) - (delay (delay (constr 2 []))) - (delay (delay (constr 1 [])))))))))))) - (\ds ds -> - case - ds - [ (\n d -> - case - ds - [ (\n' d' -> - force ifThenElse - (lessThanEqualsInteger - (multiplyInteger n d') - (multiplyInteger n' d)) - (constr 0 []) - (constr 1 [])) ]) ])) - (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file + (force + (force ifThenElse + (equalsInteger 0 d!1) + (delay (delay error)) + (delay + (delay + (force + (force + (force ifThenElse + (lessThanInteger d!1 0) + (delay + (delay + (unsafeRatio!3 + (subtractInteger + 0 + n!2) + (subtractInteger + 0 + d!1)))) + (delay + (delay + ((\gcd'!0 -> + constr 0 + [ (quotientInteger + n!3 + gcd'!1) + , (quotientInteger + d!2 + gcd'!1) ]) + (euclid!4 + n!2 + d!1)))))))))))))) + (fix1!4 + (\euclid!0 x!0 y!0 -> + force + (force + (force ifThenElse + (equalsInteger 0 y!1) + (delay (delay x!2)) + (delay + (delay + (euclid!3 y!1 (modInteger x!2 y!1))))))))) + (\`$dOrd`!0 ds!0 ds!0 -> + fix1!6 + (\go!0 ds!0 -> + force + (case + ds!1 + [ (delay (constr 0 [])) + , (\x!0 xs!0 -> + delay + (case + x!2 + [ (\predKey!0 expectedPredValues!0 -> + (\meaning!0 -> + fix1!13 + (\go!0 ds!0 -> + force + (case + ds!1 + [ (delay (go!9 xs!6)) + , (\x!0 xs!0 -> + delay + (force + (case + (meaning!5 + x!2 + ds!12) + [ (delay + (go!4 + xs!1)) + , (delay + (constr 1 + [ ])) ]))) ])) + expectedPredValues!2) + (force + (case + predKey!2 + [ (delay + (case + `$dOrd`!9 + [ (\v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 -> + v!3) ])) + , (delay + (case + `$dOrd`!9 + [ (\v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 -> + v!5) ])) + , (delay + (\x!0 y!0 -> + force + (case + (case + `$dOrd`!11 + [ (\v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 + v!0 -> + v!8) ] + x!2 + y!1) + [ (delay + (constr 1 + [])) + , (delay + (constr 0 + [ ])) ]))) ]))) ])) ])) + ds!2)) + (\eta!0 eta!0 -> + force + (force + (force ifThenElse + (equalsInteger eta!2 eta!1) + (delay (delay (constr 0 []))) + (delay + (delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger eta!2 eta!1) + (delay (delay (constr 2 []))) + (delay (delay (constr 1 [])))))))))))) + (\ds!0 ds!0 -> + case + ds!2 + [ (\n!0 d!0 -> + case + ds!3 + [ (\n'!0 d'!0 -> + force ifThenElse + (lessThanEqualsInteger + (multiplyInteger n!4 d'!1) + (multiplyInteger n'!2 d!3)) + (constr 0 []) + (constr 1 [])) ]) ])) + (\f!0 -> (\s!0 -> s!1 s!1) (\s!0 -> f!2 (\x!0 -> s!2 s!2 x!1)))) diff --git a/plutus-core/plutus-core/test/scopes/apply.plc.golden b/plutus-core/plutus-core/test/scopes/apply.plc.golden index 8f21ffcbf75..f80658652d5 100644 --- a/plutus-core/plutus-core/test/scopes/apply.plc.golden +++ b/plutus-core/plutus-core/test/scopes/apply.plc.golden @@ -1,3 +1,3 @@ (program - 0.1.0 (lam x_4 y_1 (lam x_5 z_2 [ [ [ f_3 x_5 ] (lam x_6 y_1 x_6) ] x_5 ])) + 0.1.0 (lam x-4 y-1 (lam x-5 z-2 [ [ [ f-3 x-5 ] (lam x-6 y-1 x-6) ] x-5 ])) ) \ No newline at end of file diff --git a/plutus-core/plutus-core/test/scopes/lambda.plc.golden b/plutus-core/plutus-core/test/scopes/lambda.plc.golden index 2bb8ba7a306..26cb6ba44ef 100644 --- a/plutus-core/plutus-core/test/scopes/lambda.plc.golden +++ b/plutus-core/plutus-core/test/scopes/lambda.plc.golden @@ -1 +1 @@ -(program 0.1.0 (lam x_3 y_1 (lam x_4 z_2 [ [ (builtin addInteger) x_4 ] x_4 ]))) \ No newline at end of file +(program 0.1.0 (lam x-3 y-1 (lam x-4 z-2 [ [ (builtin addInteger) x-4 ] x-4 ]))) \ No newline at end of file diff --git a/plutus-core/plutus-core/test/scopes/lambda2.plc.golden b/plutus-core/plutus-core/test/scopes/lambda2.plc.golden index 14ed9deb223..02be190b111 100644 --- a/plutus-core/plutus-core/test/scopes/lambda2.plc.golden +++ b/plutus-core/plutus-core/test/scopes/lambda2.plc.golden @@ -1 +1 @@ -(program 0.1.0 (lam x_6 y_1 (lam x_7 z_2 [ (lam f_8 t_4 j_5) x_7 ]))) \ No newline at end of file +(program 0.1.0 (lam x-6 y-1 (lam x-7 z-2 [ (lam f-8 t-4 j-5) x-7 ]))) \ No newline at end of file diff --git a/plutus-core/plutus-core/test/scopes/negation.plc.golden b/plutus-core/plutus-core/test/scopes/negation.plc.golden index 33814065d0d..38725e552b2 100644 --- a/plutus-core/plutus-core/test/scopes/negation.plc.golden +++ b/plutus-core/plutus-core/test/scopes/negation.plc.golden @@ -1,28 +1,28 @@ (program 0.1.0 (lam - x_6 - (all a_7 (type) (fun a_7 (fun a_7 a_7))) + x-6 + (all a-7 (type) (fun a-7 (fun a-7 a-7))) [ [ [ { (abs - b_8 + b-8 (type) (lam - x_9 - (all a_10 (type) (fun a_10 (fun a_10 a_10))) - (lam t_11 b_8 (lam f_12 b_8 [ [ { x_9 b_8 } t_11 ] f_12 ])) + x-9 + (all a-10 (type) (fun a-10 (fun a-10 a-10))) + (lam t-11 b-8 (lam f-12 b-8 [ [ { x-9 b-8 } t-11 ] f-12 ])) ) ) - (all a_13 (type) (fun a_13 (fun a_13 a_13))) + (all a-13 (type) (fun a-13 (fun a-13 a-13))) } - x_6 + x-6 ] - (abs a_14 (type) (lam x_15 a_14 (lam y_16 a_14 y_16))) + (abs a-14 (type) (lam x-15 a-14 (lam y-16 a-14 y-16))) ] - (abs a_17 (type) (lam t_18 a_17 (lam f_19 a_17 t_18))) + (abs a-17 (type) (lam t-18 a-17 (lam f-19 a-17 t-18))) ] ) ) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/dataEscape.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/dataEscape.golden index 14a08a29a46..9297141283f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/dataEscape.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/dataEscape.golden @@ -1 +1 @@ -(all a_16 (type) (fun a_16 [ Maybe_5 a_16 ])) \ No newline at end of file +all a-16. a-16 -> Maybe-5 a-16 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/idleAll.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/idleAll.golden index 6f1e7b741fe..63e48a22071 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/idleAll.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/idleAll.golden @@ -1,3 +1,3 @@ Error during PIR typechecking: The result-type of a dataconstructor is malformed at location idleAll:12:5-17:5 -The expected result-type is: [ D2 a ] \ No newline at end of file +The expected result-type is: [ D2-12 a-15 ] \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/listMatch.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/listMatch.golden index 1c8b64aad9f..6f1c382ac7a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/listMatch.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/listMatch.golden @@ -1,206 +1,50 @@ -(program +program 1.1.0 - [ - [ - [ - { - (abs - List_i0 - (fun (type) (type)) - (lam - Nil_i0 - (all a_i0 (type) [ List_i3 a_i1 ]) - (lam - Cons_i0 - (all - a_i0 (type) (fun a_i1 (fun [ List_i4 a_i1 ] [ List_i4 a_i1 ])) - ) - (lam - match_List_i0 - (all - a_i0 - (type) - (fun - [ List_i5 a_i1 ] - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun a_i2 (fun [ List_i6 a_i2 ] out_List_i1)) - out_List_i1 - ) - ) - ) - ) - ) - (abs a_i0 (type) (lam x_i0 a_i2 x_i1)) - ) - ) - ) - ) - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam a_i0 (type) (sop [] [a_i1 [ List_i2 a_i1 ]])) - ) - a_i1 - ) - ) - } - (abs - a_i0 - (type) - (iwrap - (lam - List_i0 - (fun (type) (type)) - (lam a_i0 (type) (sop [] [a_i1 [ List_i2 a_i1 ]])) - ) - a_i1 - (constr - (sop + ((/\(List :: * -> *) -> + \(Nil : all a. List a) + (Cons : all a. a -> List a -> List a) + (match_List : + all a. + List a -> + (all out_List. + out_List -> (a -> List a -> out_List) -> out_List)) -> + /\a -> \(x : a) -> x) + {\a -> ifix (\(List :: * -> *) a -> sop [] [a, (List a)]) a} + (/\a -> + iwrap + (\(List :: * -> *) a -> sop [] [a, (List a)]) + a + (constr + (sop [] - [a_i1 - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam a_i0 (type) (sop [] [a_i1 [ List_i2 a_i1 ]])) - ) - a_i1 - ) - ) - a_i1 - ]] - ) - 0 - ) - ) - ) - ] - (abs - a_i0 - (type) - (lam - arg_0_i0 - a_i2 - (lam - arg_1_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam a_i0 (type) (sop [] [a_i1 [ List_i2 a_i1 ]])) - ) - a_i1 - ) - ) - a_i3 - ] - (iwrap - (lam - List_i0 - (fun (type) (type)) - (lam a_i0 (type) (sop [] [a_i1 [ List_i2 a_i1 ]])) - ) - a_i3 - (constr - (sop + [ a + , ((\a -> ifix (\(List :: * -> *) a -> sop [] [a, (List a)]) a) + a) ]) + 0 + [])) + (/\a -> + \(arg_0 : a) + (arg_1 : + (\a -> ifix (\(List :: * -> *) a -> sop [] [a, (List a)]) a) a) -> + iwrap + (\(List :: * -> *) a -> sop [] [a, (List a)]) + a + (constr + (sop [] - [a_i3 - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam a_i0 (type) (sop [] [a_i1 [ List_i2 a_i1 ]])) - ) - a_i1 - ) - ) - a_i3 - ]] - ) - 1 - arg_0_i2 - arg_1_i1 - ) - ) - ) - ) - ) - ] - (abs - a_i0 - (type) - (lam - x_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam a_i0 (type) (sop [] [a_i1 [ List_i2 a_i1 ]])) - ) - a_i1 - ) - ) - a_i2 - ] - (abs - out_List_i0 - (type) - (lam - case_Nil_i0 - out_List_i2 - (lam - case_Cons_i0 - (fun - a_i5 - (fun - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam a_i0 (type) (sop [] [a_i1 [ List_i2 a_i1 ]])) - ) - a_i1 - ) - ) - a_i5 - ] - out_List_i3 - ) - ) - (case out_List_i3 (unwrap x_i4) case_Nil_i2 case_Cons_i1) - ) - ) - ) - ) - ) - ] -) \ No newline at end of file + [ a + , ((\a -> + ifix (\(List :: * -> *) a -> sop [] [a, (List a)]) a) + a) ]) + 1 + [arg_0, arg_1])) + (/\a -> + \(x : (\a -> ifix (\(List :: * -> *) a -> sop [] [a, (List a)]) a) a) -> + /\out_List -> + \(case_Nil : out_List) + (case_Cons : + a -> + (\a -> ifix (\(List :: * -> *) a -> sop [] [a, (List a)]) a) + a -> + out_List) -> + case out_List (unwrap x) [case_Nil, case_Cons])) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/listMatchEval.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/listMatchEval.golden index 5d050430f86..52e9437ecf6 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/listMatchEval.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/listMatchEval.golden @@ -1 +1 @@ -(delay (lam x_0 x_0)) \ No newline at end of file +delay (\x -> x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/maybe.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/maybe.golden index fe70eba596c..ea9bfb24453 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/maybe.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/maybe.golden @@ -1,74 +1,20 @@ -(program +program 1.1.0 - [ - { - [ - [ - [ - { - (abs - Maybe_i0 - (fun (type) (type)) - (lam - Nothing_i0 - (all a_i0 (type) [ Maybe_i3 a_i1 ]) - (lam - Just_i0 - (all a_i0 (type) (fun a_i1 [ Maybe_i4 a_i1 ])) - (lam - match_Maybe_i0 - (all - a_i0 - (type) - (fun - [ Maybe_i5 a_i1 ] - (all - out_Maybe_i0 - (type) - (fun - out_Maybe_i1 - (fun (fun a_i2 out_Maybe_i1) out_Maybe_i1) - ) - ) - ) - ) - Just_i2 - ) - ) - ) - ) - (lam a_i0 (type) (sop [] [a_i1])) - } - (abs a_i0 (type) (constr (sop [] [a_i1]) 0)) - ] - (abs - a_i0 (type) (lam arg_0_i0 a_i2 (constr (sop [] [a_i2]) 1 arg_0_i1)) - ) - ] - (abs - a_i0 - (type) - (lam - x_i0 - [ (lam a_i0 (type) (sop [] [a_i1])) a_i2 ] - (abs - out_Maybe_i0 - (type) - (lam - case_Nothing_i0 - out_Maybe_i2 - (lam - case_Just_i0 - (fun a_i5 out_Maybe_i3) - (case out_Maybe_i3 x_i4 case_Nothing_i2 case_Just_i1) - ) - ) - ) - ) - ) - ] - (all a_i0 (type) (fun a_i1 a_i1)) - } - (abs a_i0 (type) (lam x_i0 a_i2 x_i1)) - ] -) \ No newline at end of file + ((/\(Maybe :: * -> *) -> + \(Nothing : all a. Maybe a) + (Just : all a. a -> Maybe a) + (match_Maybe : + all a. + Maybe a -> + (all out_Maybe. out_Maybe -> (a -> out_Maybe) -> out_Maybe)) -> + Just) + {\a -> sop [] [a]} + (/\a -> constr (sop [] [a]) 0 []) + (/\a -> \(arg_0 : a) -> constr (sop [] [a]) 1 [arg_0]) + (/\a -> + \(x : (\a -> sop [] [a]) a) -> + /\out_Maybe -> + \(case_Nothing : out_Maybe) (case_Just : a -> out_Maybe) -> + case out_Maybe x [case_Nothing, case_Just]) + {all a. a -> a} + (/\a -> \(x : a) -> x)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/scott/listMatch.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/scott/listMatch.golden index 2d3828573fc..84182c73f8f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/scott/listMatch.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/scott/listMatch.golden @@ -1,296 +1,71 @@ -(program +program 1.1.0 - [ - [ - [ - { - (abs - List_i0 - (fun (type) (type)) - (lam - Nil_i0 - (all a_i0 (type) [ List_i3 a_i1 ]) - (lam - Cons_i0 - (all - a_i0 (type) (fun a_i1 (fun [ List_i4 a_i1 ] [ List_i4 a_i1 ])) - ) - (lam - match_List_i0 - (all - a_i0 - (type) - (fun - [ List_i5 a_i1 ] - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun a_i2 (fun [ List_i6 a_i2 ] out_List_i1)) - out_List_i1 - ) - ) - ) - ) - ) - (abs a_i0 (type) (lam x_i0 a_i2 x_i1)) - ) - ) - ) - ) - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun a_i2 (fun [ List_i3 a_i2 ] out_List_i1)) - out_List_i1 - ) - ) - ) - ) - ) - a_i1 - ) - ) - } - (abs - a_i0 - (type) - (iwrap - (lam - List_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun a_i2 (fun [ List_i3 a_i2 ] out_List_i1)) out_List_i1 - ) - ) - ) - ) - ) - a_i1 - (abs - out_List_i0 - (type) - (lam - case_Nil_i0 - out_List_i2 - (lam - case_Cons_i0 - (fun - a_i4 - (fun - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun - a_i2 (fun [ List_i3 a_i2 ] out_List_i1) - ) - out_List_i1 - ) - ) - ) - ) - ) - a_i1 - ) - ) - a_i4 - ] - out_List_i3 - ) - ) - case_Nil_i2 - ) - ) - ) - ) - ) - ] - (abs - a_i0 - (type) - (lam - arg_0_i0 - a_i2 - (lam - arg_1_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun a_i2 (fun [ List_i3 a_i2 ] out_List_i1)) - out_List_i1 - ) - ) - ) - ) - ) - a_i1 - ) - ) - a_i3 - ] - (iwrap - (lam - List_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun a_i2 (fun [ List_i3 a_i2 ] out_List_i1)) - out_List_i1 - ) - ) - ) - ) - ) - a_i3 - (abs - out_List_i0 - (type) - (lam - case_Nil_i0 - out_List_i2 - (lam - case_Cons_i0 - (fun - a_i6 - (fun - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun - a_i2 - (fun [ List_i3 a_i2 ] out_List_i1) - ) - out_List_i1 - ) - ) - ) - ) - ) - a_i1 - ) - ) - a_i6 - ] - out_List_i3 - ) - ) - [ [ case_Cons_i1 arg_0_i5 ] arg_1_i4 ] - ) - ) - ) - ) - ) - ) - ) - ] - (abs - a_i0 - (type) - (lam - x_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - List_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (all - out_List_i0 - (type) - (fun - out_List_i1 - (fun - (fun a_i2 (fun [ List_i3 a_i2 ] out_List_i1)) - out_List_i1 - ) - ) - ) - ) - ) - a_i1 - ) - ) - a_i2 - ] - (unwrap x_i1) - ) - ) - ] -) \ No newline at end of file + ((/\(List :: * -> *) -> + \(Nil : all a. List a) + (Cons : all a. a -> List a -> List a) + (match_List : + all a. + List a -> + (all out_List. + out_List -> (a -> List a -> out_List) -> out_List)) -> + /\a -> \(x : a) -> x) + {\a -> + ifix + (\(List :: * -> *) a -> + all out_List. out_List -> (a -> List a -> out_List) -> out_List) + a} + (/\a -> + iwrap + (\(List :: * -> *) a -> + all out_List. out_List -> (a -> List a -> out_List) -> out_List) + a + (/\out_List -> + \(case_Nil : out_List) + (case_Cons : + a -> + (\a -> + ifix + (\(List :: * -> *) a -> + all out_List. + out_List -> (a -> List a -> out_List) -> out_List) + a) + a -> + out_List) -> + case_Nil)) + (/\a -> + \(arg_0 : a) + (arg_1 : + (\a -> + ifix + (\(List :: * -> *) a -> + all out_List. + out_List -> (a -> List a -> out_List) -> out_List) + a) + a) -> + iwrap + (\(List :: * -> *) a -> + all out_List. out_List -> (a -> List a -> out_List) -> out_List) + a + (/\out_List -> + \(case_Nil : out_List) + (case_Cons : + a -> + (\a -> + ifix + (\(List :: * -> *) a -> + all out_List. + out_List -> (a -> List a -> out_List) -> out_List) + a) + a -> + out_List) -> + case_Cons arg_0 arg_1)) + (/\a -> + \(x : + (\a -> + ifix + (\(List :: * -> *) a -> + all out_List. + out_List -> (a -> List a -> out_List) -> out_List) + a) + a) -> + unwrap x)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/scott/maybe.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/scott/maybe.golden index 6bf072fa224..1c9ca6d10a2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/scott/maybe.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/scott/maybe.golden @@ -1,111 +1,26 @@ -(program +program 1.1.0 - [ - { - [ - [ - [ - { - (abs - Maybe_i0 - (fun (type) (type)) - (lam - Nothing_i0 - (all a_i0 (type) [ Maybe_i3 a_i1 ]) - (lam - Just_i0 - (all a_i0 (type) (fun a_i1 [ Maybe_i4 a_i1 ])) - (lam - match_Maybe_i0 - (all - a_i0 - (type) - (fun - [ Maybe_i5 a_i1 ] - (all - out_Maybe_i0 - (type) - (fun - out_Maybe_i1 - (fun (fun a_i2 out_Maybe_i1) out_Maybe_i1) - ) - ) - ) - ) - Just_i2 - ) - ) - ) - ) - (lam - a_i0 - (type) - (all - out_Maybe_i0 - (type) - (fun out_Maybe_i1 (fun (fun a_i2 out_Maybe_i1) out_Maybe_i1)) - ) - ) - } - (abs - a_i0 - (type) - (abs - out_Maybe_i0 - (type) - (lam - case_Nothing_i0 - out_Maybe_i2 - (lam case_Just_i0 (fun a_i4 out_Maybe_i3) case_Nothing_i2) - ) - ) - ) - ] - (abs - a_i0 - (type) - (lam - arg_0_i0 - a_i2 - (abs - out_Maybe_i0 - (type) - (lam - case_Nothing_i0 - out_Maybe_i2 - (lam - case_Just_i0 - (fun a_i5 out_Maybe_i3) - [ case_Just_i1 arg_0_i4 ] - ) - ) - ) - ) - ) - ] - (abs - a_i0 - (type) - (lam - x_i0 - [ - (lam - a_i0 - (type) - (all - out_Maybe_i0 - (type) - (fun out_Maybe_i1 (fun (fun a_i2 out_Maybe_i1) out_Maybe_i1)) - ) - ) - a_i2 - ] - x_i1 - ) - ) - ] - (all a_i0 (type) (fun a_i1 a_i1)) - } - (abs a_i0 (type) (lam x_i0 a_i2 x_i1)) - ] -) \ No newline at end of file + ((/\(Maybe :: * -> *) -> + \(Nothing : all a. Maybe a) + (Just : all a. a -> Maybe a) + (match_Maybe : + all a. + Maybe a -> + (all out_Maybe. out_Maybe -> (a -> out_Maybe) -> out_Maybe)) -> + Just) + {\a -> all out_Maybe. out_Maybe -> (a -> out_Maybe) -> out_Maybe} + (/\a out_Maybe -> + \(case_Nothing : out_Maybe) (case_Just : a -> out_Maybe) -> + case_Nothing) + (/\a -> + \(arg_0 : a) -> + /\out_Maybe -> + \(case_Nothing : out_Maybe) (case_Just : a -> out_Maybe) -> + case_Just arg_0) + (/\a -> + \(x : + (\a -> all out_Maybe. out_Maybe -> (a -> out_Maybe) -> out_Maybe) + a) -> + x) + {all a. a -> a} + (/\a -> \(x : a) -> x)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/some.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/some.golden index 9b263e9029b..c77d8e258cd 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/some.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Datatype/some.golden @@ -1,3 +1,3 @@ Error during PIR typechecking: The result-type of a dataconstructor is malformed at location some:4:5-9:5 -The expected result-type is: [ Some f ] \ No newline at end of file +The expected result-type is: [ Some-6 f-9 ] \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/recursiveTypeBind.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/recursiveTypeBind.golden index e76c28f6843..8171467f647 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/recursiveTypeBind.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Error/recursiveTypeBind.golden @@ -1,2 +1,4 @@ Error during compilation: Type bindings cannot appear in recursive let, use datatypebind insteadThe type binding is - (typebind (tyvardecl unit (type)) (all a (type) (fun unit unit)))((recursive) let binding; from recursiveTypeBind:1:1-11:1) \ No newline at end of file + (typebind + (tyvardecl unit-173 (type)) (all a-174 (type) (fun unit-173 unit-173)) +)((recursive) let binding; from recursiveTypeBind:1:1-11:1) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/letDep.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/letDep.golden index 0b14f2e0e8f..666b9536146 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/letDep.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/letDep.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 3)) \ No newline at end of file +program 1.1.0 3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/letInLet.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/letInLet.golden index e388e692288..0bc71713483 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/letInLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Let/letInLet.golden @@ -1 +1 @@ -(program 1.1.0 (abs a_i0 (type) (lam x_i0 a_i2 x_i1))) \ No newline at end of file +program 1.1.0 (/\a -> \(x : a) -> x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3.golden index 3a0b1ae9696..1d6982b4a9f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3.golden @@ -1,636 +1,123 @@ -(program +program 1.1.0 - [ - [ - [ - { - (abs - Bool_i0 - (type) - (lam - True_i0 - Bool_i2 - (lam - False_i0 - Bool_i3 - (lam - match_Bool_i0 - (fun - Bool_i4 - (all - out_Bool_i0 - (type) - (fun out_Bool_i1 (fun out_Bool_i1 out_Bool_i1)) - ) - ) - [ - [ - [ - { - (abs - Nat_i0 - (type) - (lam - Zero_i0 - Nat_i2 - (lam - Suc_i0 - (fun Nat_i3 Nat_i3) - (lam - match_Nat_i0 - (fun - Nat_i4 - (all - out_Nat_i0 - (type) - (fun - out_Nat_i1 - (fun (fun Nat_i5 out_Nat_i1) out_Nat_i1) - ) - ) - ) - [ - (lam - tup_i0 - (all - r_i0 - (type) - (fun - (fun - (fun Nat_i6 Bool_i10) - (fun (fun Nat_i6 Bool_i10) r_i1) - ) - r_i1 - ) - ) - [ - (lam - even_i0 - (fun Nat_i6 Bool_i10) - [ - (lam - odd_i0 - (fun Nat_i7 Bool_i11) - [ - even_i2 - [ - Suc_i5 - [ Suc_i5 [ Suc_i5 Zero_i6 ] ] - ] - ] - ) - [ - { tup_i2 (fun Nat_i6 Bool_i10) } - (lam - arg_0_i0 - (fun Nat_i7 Bool_i11) - (lam - arg_1_i0 - (fun Nat_i8 Bool_i12) - arg_1_i1 - ) - ) - ] - ] - ) - [ - { tup_i1 (fun Nat_i5 Bool_i9) } - (lam - arg_0_i0 - (fun Nat_i6 Bool_i10) - (lam - arg_1_i0 - (fun Nat_i7 Bool_i11) - arg_0_i2 - ) - ) - ] - ] - ) - [ - [ - { - (abs - F_i0 - (fun (type) (type)) - (lam - by_i0 - (fun - (all - Q_i0 - (type) - (fun [ F_i3 Q_i1 ] Q_i1) - ) - (all - Q_i0 - (type) - (fun [ F_i3 Q_i1 ] Q_i1) - ) - ) - [ - { - { - (abs - a_i0 - (type) - (abs - b_i0 - (type) - (lam - f_i0 - (fun - (fun a_i3 b_i2) - (fun a_i3 b_i2) - ) - [ - (lam - s_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - self_i0 - (fun - (type) - (type) - ) - (lam - a_i0 - (type) - (fun - [ - self_i2 - a_i1 - ] - a_i1 - ) - ) - ) - a_i1 - ) - ) - (fun a_i4 b_i3) - ] - [ - (unwrap s_i1) - s_i1 - ] - ) - (iwrap - (lam - self_i0 - (fun - (type) (type) - ) - (lam - a_i0 - (type) - (fun - [ - self_i2 - a_i1 - ] - a_i1 - ) - ) - ) - (fun a_i3 b_i2) - (lam - s_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - self_i0 - (fun - (type) - (type) - ) - (lam - a_i0 - (type) - (fun - [ - self_i2 - a_i1 - ] - a_i1 - ) - ) - ) - a_i1 - ) - ) - (fun - a_i4 b_i3 - ) - ] - [ - f_i2 - (lam - x_i0 - a_i5 - [ - [ - (unwrap - s_i2 - ) - s_i2 - ] - x_i1 - ] - ) - ] - ) - ) - ] - ) - ) - ) - (all - Q_i0 - (type) - (fun - [ F_i3 Q_i1 ] - [ F_i3 Q_i1 ] - ) - ) - } - (all - Q_i0 - (type) - (fun [ F_i3 Q_i1 ] Q_i1) - ) - } - (lam - rec_i0 - (fun - (all - Q_i0 - (type) - (fun - [ F_i4 Q_i1 ] - [ F_i4 Q_i1 ] - ) - ) - (all - Q_i0 - (type) - (fun [ F_i4 Q_i1 ] Q_i1) - ) - ) - (lam - h_i0 - (all - Q_i0 - (type) - (fun - [ F_i5 Q_i1 ] - [ F_i5 Q_i1 ] - ) - ) - (abs - R_i0 - (type) - (lam - fr_i0 - [ F_i6 R_i2 ] - [ - { - [ - by_i5 - (abs - Q_i0 - (type) - (lam - fq_i0 - [ F_i8 Q_i2 ] - [ - { - [ - rec_i6 - h_i5 - ] - Q_i2 - } - [ - { - h_i5 - Q_i2 - } - fq_i1 - ] - ] - ) - ) - ] - R_i2 - } - fr_i1 - ] - ) - ) - ) - ) - ] - ) - ) - (lam - X_i0 - (type) - (fun - (fun Nat_i5 Bool_i9) - (fun (fun Nat_i5 Bool_i9) X_i1) - ) - ) - } - (lam - k_i0 - (all - Q_i0 - (type) - (fun - (fun - (fun Nat_i6 Bool_i10) - (fun (fun Nat_i6 Bool_i10) Q_i1) - ) - Q_i1 - ) - ) - (abs - S_i0 - (type) - (lam - h_i0 - (fun - (fun Nat_i7 Bool_i11) - (fun (fun Nat_i7 Bool_i11) S_i2) - ) - [ - [ - h_i1 - (lam - x_i0 - Nat_i8 - [ - { k_i4 Bool_i12 } - (lam - f_0_i0 - (fun Nat_i9 Bool_i13) - (lam - f_1_i0 - (fun Nat_i10 Bool_i14) - [ f_0_i2 x_i3 ] - ) - ) - ] - ) - ] - (lam - x_i0 - Nat_i8 - [ - { k_i4 Bool_i12 } - (lam - f_0_i0 - (fun Nat_i9 Bool_i13) - (lam - f_1_i0 - (fun Nat_i10 Bool_i14) - [ f_1_i1 x_i3 ] - ) - ) - ] - ) - ] - ) - ) - ) - ] - (abs - Q_i0 - (type) - (lam - choose_i0 - (fun - (fun Nat_i6 Bool_i10) - (fun (fun Nat_i6 Bool_i10) Q_i2) - ) - (lam - even_i0 - (fun Nat_i7 Bool_i11) - (lam - odd_i0 - (fun Nat_i8 Bool_i12) - [ - [ - choose_i3 - (lam - n_i0 - Nat_i9 - [ - [ - { - [ match_Nat_i6 n_i1 ] - Bool_i13 - } - True_i12 - ] - (lam - p_i0 - Nat_i10 - [ odd_i3 p_i1 ] - ) - ] - ) - ] - (lam - n_i0 - Nat_i9 - [ - [ - { - [ match_Nat_i6 n_i1 ] - Bool_i13 - } - False_i11 - ] - (lam - p_i0 - Nat_i10 - [ even_i4 p_i1 ] - ) - ] - ) - ] - ) - ) - ) - ) - ] - ] - ) - ) - ) - ) - (ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam - f_i0 - (fun (type) (type)) - [ f_i1 [ rec_i2 f_i1 ] ] - ) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - ) - } - (iwrap - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam - f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ] - ) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - (constr - (sop - [] - [(ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam - f_i0 - (fun (type) (type)) - [ f_i1 [ rec_i2 f_i1 ] ] - ) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - )] - ) - 0 - ) - ) - ] - (lam - arg_0_i0 - (ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam - f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ] - ) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - ) - (iwrap - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam - f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ] - ) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - (constr - (sop - [] - [(ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam - f_i0 - (fun (type) (type)) - [ f_i1 [ rec_i2 f_i1 ] ] - ) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - )] - ) - 1 - arg_0_i1 - ) - ) - ) - ] - (lam - x_i0 - (ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam - f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ] - ) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - ) - (abs - out_Nat_i0 - (type) - (lam - case_Zero_i0 - out_Nat_i2 - (lam - case_Suc_i0 - (fun - (ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam - f_i0 - (fun (type) (type)) - [ f_i1 [ rec_i2 f_i1 ] ] - ) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - ) - out_Nat_i3 - ) - (case - out_Nat_i3 (unwrap x_i4) case_Zero_i2 case_Suc_i1 - ) - ) - ) - ) - ) - ] - ) - ) - ) - ) - (sop [] []) - } - (constr (sop [] []) 0) - ] - (constr (sop [] []) 1) - ] - (lam - x_i0 - (sop [] []) - (abs - out_Bool_i0 - (type) - (lam - case_True_i0 - out_Bool_i2 - (lam - case_False_i0 - out_Bool_i3 - (case out_Bool_i3 x_i4 case_True_i2 case_False_i1) - ) - ) - ) - ) - ] -) \ No newline at end of file + ((/\Bool -> + \(True : Bool) + (False : Bool) + (match_Bool : + Bool -> (all out_Bool. out_Bool -> out_Bool -> out_Bool)) -> + (/\Nat -> + \(Zero : Nat) + (Suc : Nat -> Nat) + (match_Nat : + Nat -> (all out_Nat. out_Nat -> (Nat -> out_Nat) -> out_Nat)) -> + (\(tup : all r. ((Nat -> Bool) -> (Nat -> Bool) -> r) -> r) -> + (\(even : Nat -> Bool) -> + (\(odd : Nat -> Bool) -> even (Suc (Suc (Suc Zero)))) + (tup + {Nat -> Bool} + (\(arg_0 : Nat -> Bool) (arg_1 : Nat -> Bool) -> + arg_1))) + (tup + {Nat -> Bool} + (\(arg_0 : Nat -> Bool) (arg_1 : Nat -> Bool) -> arg_0))) + ((/\(F :: * -> *) -> + \(by : (all Q. F Q -> Q) -> (all Q. F Q -> Q)) -> + (/\a b -> + \(f : (a -> b) -> a -> b) -> + (\(s : + (\a -> + ifix (\(self :: * -> *) a -> self a -> a) a) + (a -> b)) -> + unwrap s s) + (iwrap + (\(self :: * -> *) a -> self a -> a) + (a -> b) + (\(s : + (\a -> + ifix + (\(self :: * -> *) a -> self a -> a) + a) + (a -> b)) -> + f (\(x : a) -> unwrap s s x)))) + {all Q. F Q -> F Q} + {all Q. F Q -> Q} + (\(rec : (all Q. F Q -> F Q) -> (all Q. F Q -> Q)) + (h : all Q. F Q -> F Q) -> + /\R -> + \(fr : F R) -> + by + (/\Q -> \(fq : F Q) -> rec h {Q} (h {Q} fq)) + {R} + fr)) + {\X -> (Nat -> Bool) -> (Nat -> Bool) -> X} + (\(k : all Q. ((Nat -> Bool) -> (Nat -> Bool) -> Q) -> Q) -> + /\S -> + \(h : (Nat -> Bool) -> (Nat -> Bool) -> S) -> + h + (\(x : Nat) -> + k + {Bool} + (\(f_0 : Nat -> Bool) (f_1 : Nat -> Bool) -> + f_0 x)) + (\(x : Nat) -> + k + {Bool} + (\(f_0 : Nat -> Bool) (f_1 : Nat -> Bool) -> + f_1 x))) + (/\Q -> + \(choose : (Nat -> Bool) -> (Nat -> Bool) -> Q) + (even : Nat -> Bool) + (odd : Nat -> Bool) -> + choose + (\(n : Nat) -> + match_Nat n {Bool} True (\(p : Nat) -> odd p)) + (\(n : Nat) -> + match_Nat n {Bool} False (\(p : Nat) -> even p))))) + {ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])} + (iwrap + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat]) + (constr + (sop + [] + [ (ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])) ]) + 0 + [])) + (\(arg_0 : + ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])) -> + iwrap + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat]) + (constr + (sop + [] + [ (ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])) ]) + 1 + [arg_0])) + (\(x : + ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])) -> + /\out_Nat -> + \(case_Zero : out_Nat) + (case_Suc : + ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat]) -> + out_Nat) -> + case out_Nat (unwrap x) [case_Zero, case_Suc])) + {sop [] []} + (constr (sop [] []) 0 []) + (constr (sop [] []) 1 []) + (\(x : sop [] []) -> + /\out_Bool -> + \(case_True : out_Bool) (case_False : out_Bool) -> + case out_Bool x [case_True, case_False])) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3Eval.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3Eval.golden index f217693e82c..3a05a39aa43 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3Eval.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/even3Eval.golden @@ -1 +1 @@ -(constr 1) \ No newline at end of file +constr 1 [] \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/factorial.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/factorial.golden index 2279d9e31b8..b6c93df7bb7 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/factorial.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/factorial.golden @@ -1,37 +1,10 @@ -(program +program 1.1.0 - [ - [ - (lam s_1354 [ s_1354 s_1354 ]) - (lam - s_1355 - (lam - i_1356 - [ - [ - [ - [ - (force (builtin ifThenElse)) - [ [ (builtin equalsInteger) (con integer 0) ] i_1356 ] - ] - (lam u_1357 (con integer 1)) - ] - (lam - u_1358 - [ - [ (builtin multiplyInteger) i_1356 ] - [ - (lam x_1359 [ [ s_1355 s_1355 ] x_1359 ]) - [ [ (builtin subtractInteger) i_1356 ] (con integer 1) ] - ] - ] - ) - ] - (con unit ()) - ] - ) - ) - ] - (con integer 5) - ] -) \ No newline at end of file + ((\s -> s s) + (\s i -> + force ifThenElse + (equalsInteger 0 i) + (\u -> 1) + (\u -> multiplyInteger i ((\x -> s s x) (subtractInteger i 1))) + ()) + 5) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/mutuallyRecursiveValues.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/mutuallyRecursiveValues.golden index 0818ff6bb40..bb0ec557725 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/mutuallyRecursiveValues.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/mutuallyRecursiveValues.golden @@ -1,442 +1,77 @@ -(program +program 1.1.0 - [ - (lam - tup_i0 - (all - r_i0 - (type) - (fun - (fun - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - (fun - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - r_i1 - ) - ) - r_i1 - ) - ) - [ - (lam - x_i0 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) (all a_i0 (type) (fun a_i1 a_i1)) - ) - [ - (lam - y_i0 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - [ - (lam - x_i0 - (all a_i0 (type) (fun a_i1 a_i1)) - [ - (lam y_i0 (all a_i0 (type) (fun a_i1 a_i1)) x_i2) - [ y_i2 (abs a_i0 (type) (lam x_i0 a_i2 x_i1)) ] - ] - ) - [ x_i2 (abs a_i0 (type) (lam x_i0 a_i2 x_i1)) ] - ] - ) - [ - { - tup_i2 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - } - (lam - arg_0_i0 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - (lam - arg_1_i0 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - arg_1_i1 - ) - ) - ] - ] - ) - [ - { - tup_i1 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - } - (lam - arg_0_i0 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - (lam - arg_1_i0 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - arg_0_i2 - ) - ) - ] - ] - ) - [ - { - { - { - { - (abs - a_i0 - (type) - (abs - b_i0 - (type) - (abs - a_i0 - (type) - (abs - b_i0 - (type) - (lam - f_i0 - (all - Q_i0 - (type) - (fun - (fun (fun a_i6 b_i5) (fun (fun a_i4 b_i3) Q_i1)) - (fun (fun a_i6 b_i5) (fun (fun a_i4 b_i3) Q_i1)) - ) - ) - [ - [ - { - (abs - F_i0 - (fun (type) (type)) - (lam - by_i0 - (fun - (all Q_i0 (type) (fun [ F_i3 Q_i1 ] Q_i1)) - (all Q_i0 (type) (fun [ F_i3 Q_i1 ] Q_i1)) - ) - [ - { - { - (abs - a_i0 - (type) - (abs - b_i0 - (type) - (lam - f_i0 - (fun - (fun a_i3 b_i2) (fun a_i3 b_i2) - ) - [ - (lam - s_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - self_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (fun - [ self_i2 a_i1 ] - a_i1 - ) - ) - ) - a_i1 - ) - ) - (fun a_i4 b_i3) - ] - [ (unwrap s_i1) s_i1 ] - ) - (iwrap - (lam - self_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (fun - [ self_i2 a_i1 ] a_i1 - ) - ) - ) - (fun a_i3 b_i2) - (lam - s_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - self_i0 - (fun (type) (type)) - (lam - a_i0 - (type) - (fun - [ self_i2 a_i1 ] - a_i1 - ) - ) - ) - a_i1 - ) - ) - (fun a_i4 b_i3) - ] - [ - f_i2 - (lam - x_i0 - a_i5 - [ - [ (unwrap s_i2) s_i2 ] - x_i1 - ] - ) - ] - ) - ) - ] - ) - ) - ) - (all - Q_i0 - (type) - (fun [ F_i3 Q_i1 ] [ F_i3 Q_i1 ]) - ) - } - (all Q_i0 (type) (fun [ F_i3 Q_i1 ] Q_i1)) - } - (lam - rec_i0 - (fun - (all - Q_i0 - (type) - (fun [ F_i4 Q_i1 ] [ F_i4 Q_i1 ]) - ) - (all - Q_i0 (type) (fun [ F_i4 Q_i1 ] Q_i1) - ) - ) - (lam - h_i0 - (all - Q_i0 - (type) - (fun [ F_i5 Q_i1 ] [ F_i5 Q_i1 ]) - ) - (abs - R_i0 - (type) - (lam - fr_i0 - [ F_i6 R_i2 ] - [ - { - [ - by_i5 - (abs - Q_i0 - (type) - (lam - fq_i0 - [ F_i8 Q_i2 ] - [ - { [ rec_i6 h_i5 ] Q_i2 } - [ { h_i5 Q_i2 } fq_i1 ] - ] - ) - ) - ] - R_i2 - } - fr_i1 - ] - ) - ) - ) - ) - ] - ) - ) - (lam - X_i0 - (type) - (fun (fun a_i6 b_i5) (fun (fun a_i4 b_i3) X_i1)) - ) - } - (lam - k_i0 - (all - Q_i0 - (type) - (fun - (fun - (fun a_i7 b_i6) (fun (fun a_i5 b_i4) Q_i1) - ) - Q_i1 - ) - ) - (abs - S_i0 - (type) - (lam - h_i0 - (fun - (fun a_i8 b_i7) (fun (fun a_i6 b_i5) S_i2) - ) - [ - [ - h_i1 - (lam - x_i0 - a_i9 - [ - { k_i4 b_i8 } - (lam - f_0_i0 - (fun a_i10 b_i9) - (lam - f_1_i0 - (fun a_i9 b_i8) - [ f_0_i2 x_i3 ] - ) - ) - ] - ) - ] - (lam - x_i0 - a_i7 - [ - { k_i4 b_i6 } - (lam - f_0_i0 - (fun a_i10 b_i9) - (lam - f_1_i0 - (fun a_i9 b_i8) - [ f_1_i1 x_i3 ] - ) - ) - ] - ) - ] - ) - ) - ) - ] - f_i1 - ] - ) - ) - ) - ) - ) - (all a_i0 (type) (fun a_i1 a_i1)) - } - (all a_i0 (type) (fun a_i1 a_i1)) - } - (all a_i0 (type) (fun a_i1 a_i1)) - } - (all a_i0 (type) (fun a_i1 a_i1)) - } - (abs - Q_i0 - (type) - (lam - choose_i0 - (fun - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - (fun - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - Q_i2 - ) - ) - (lam - x_i0 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - (lam - y_i0 - (fun - (all a_i0 (type) (fun a_i1 a_i1)) - (all a_i0 (type) (fun a_i1 a_i1)) - ) - [ - [ - choose_i3 - (lam - arg_i0 - (all a_i0 (type) (fun a_i1 a_i1)) - [ y_i2 (abs a_i0 (type) (lam x_i0 a_i2 x_i1)) ] - ) - ] - (lam - arg_i0 - (all a_i0 (type) (fun a_i1 a_i1)) - (abs - a_i0 - (type) - (lam - z_i0 - a_i2 - [ - { [ x_i5 (abs a_i0 (type) (lam x_i0 a_i2 x_i1)) ] a_i2 } - z_i1 - ] - ) - ) - ) - ] - ) - ) - ) - ) - ] - ] -) \ No newline at end of file + ((\(tup : + all r. + (((all a. a -> a) -> (all a. a -> a)) -> + ((all a. a -> a) -> (all a. a -> a)) -> + r) -> + r) -> + (\(x : (all a. a -> a) -> (all a. a -> a)) -> + (\(y : (all a. a -> a) -> (all a. a -> a)) -> + (\(x : all a. a -> a) -> + (\(y : all a. a -> a) -> x) (y (/\a -> \(x : a) -> x))) + (x (/\a -> \(x : a) -> x))) + (tup + {(all a. a -> a) -> (all a. a -> a)} + (\(arg_0 : (all a. a -> a) -> (all a. a -> a)) + (arg_1 : (all a. a -> a) -> (all a. a -> a)) -> + arg_1))) + (tup + {(all a. a -> a) -> (all a. a -> a)} + (\(arg_0 : (all a. a -> a) -> (all a. a -> a)) + (arg_1 : (all a. a -> a) -> (all a. a -> a)) -> + arg_0))) + ((/\a b a b -> + \(f : + all Q. ((a -> b) -> (a -> b) -> Q) -> (a -> b) -> (a -> b) -> Q) -> + (/\(F :: * -> *) -> + \(by : (all Q. F Q -> Q) -> (all Q. F Q -> Q)) -> + (/\a b -> + \(f : (a -> b) -> a -> b) -> + (\(s : + (\a -> ifix (\(self :: * -> *) a -> self a -> a) a) + (a -> b)) -> + unwrap s s) + (iwrap + (\(self :: * -> *) a -> self a -> a) + (a -> b) + (\(s : + (\a -> + ifix (\(self :: * -> *) a -> self a -> a) a) + (a -> b)) -> + f (\(x : a) -> unwrap s s x)))) + {all Q. F Q -> F Q} + {all Q. F Q -> Q} + (\(rec : (all Q. F Q -> F Q) -> (all Q. F Q -> Q)) + (h : all Q. F Q -> F Q) -> + /\R -> + \(fr : F R) -> + by + (/\Q -> \(fq : F Q) -> rec h {Q} (h {Q} fq)) + {R} + fr)) + {\X -> (a -> b) -> (a -> b) -> X} + (\(k : all Q. ((a -> b) -> (a -> b) -> Q) -> Q) -> + /\S -> + \(h : (a -> b) -> (a -> b) -> S) -> + h + (\(x : a) -> + k {b} (\(f_0 : a -> b) (f_1 : a -> b) -> f_0 x)) + (\(x : a) -> + k {b} (\(f_0 : a -> b) (f_1 : a -> b) -> f_1 x))) + f) + {all a. a -> a} + {all a. a -> a} + {all a. a -> a} + {all a. a -> a} + (/\Q -> + \(choose : + ((all a. a -> a) -> (all a. a -> a)) -> + ((all a. a -> a) -> (all a. a -> a)) -> + Q) + (x : (all a. a -> a) -> (all a. a -> a)) + (y : (all a. a -> a) -> (all a. a -> a)) -> + choose + (\(arg : all a. a -> a) -> y (/\a -> \(x : a) -> x)) + (\(arg : all a. a -> a) -> + /\a -> \(z : a) -> x (/\a -> \(x : a) -> x) {a} z)))) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/stupidZero.golden b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/stupidZero.golden index aa0f65a3e63..b1da6f1fe6a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/stupidZero.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Compiler/Recursion/stupidZero.golden @@ -1,190 +1,61 @@ -(program +program 1.1.0 - [ - [ - [ - { - (abs - Nat_i0 - (type) - (lam - Zero_i0 - Nat_i2 - (lam - Suc_i0 - (fun Nat_i3 Nat_i3) - (lam - match_Nat_i0 - (fun - Nat_i4 - (all - out_Nat_i0 - (type) - (fun out_Nat_i1 (fun (fun Nat_i5 out_Nat_i1) out_Nat_i1)) - ) - ) - [ - [ - (lam - s_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - self_i0 - (fun (type) (type)) - (lam a_i0 (type) (fun [ self_i2 a_i1 ] a_i1)) - ) - a_i1 - ) - ) - (fun Nat_i5 Nat_i5) - ] - [ (unwrap s_i1) s_i1 ] - ) - (iwrap - (lam - self_i0 - (fun (type) (type)) - (lam a_i0 (type) (fun [ self_i2 a_i1 ] a_i1)) - ) - (fun Nat_i4 Nat_i4) - (lam - s_i0 - [ - (lam - a_i0 - (type) - (ifix - (lam - self_i0 - (fun (type) (type)) - (lam a_i0 (type) (fun [ self_i2 a_i1 ] a_i1)) - ) - a_i1 - ) - ) - (fun Nat_i5 Nat_i5) - ] - (lam - n_i0 - Nat_i6 - [ - [ { [ match_Nat_i3 n_i1 ] Nat_i6 } Zero_i5 ] - (lam p_i0 Nat_i7 [ [ (unwrap s_i3) s_i3 ] p_i1 ]) - ] - ) - ) - ) - ] - [ Suc_i2 [ Suc_i2 [ Suc_i2 Zero_i3 ] ] ] - ] - ) - ) - ) - ) - (ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ]) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - ) - } - (iwrap - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ]) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - (constr - (sop + ((/\Nat -> + \(Zero : Nat) + (Suc : Nat -> Nat) + (match_Nat : + Nat -> (all out_Nat. out_Nat -> (Nat -> out_Nat) -> out_Nat)) -> + (\(s : + (\a -> ifix (\(self :: * -> *) a -> self a -> a) a) + (Nat -> Nat)) -> + unwrap s s) + (iwrap + (\(self :: * -> *) a -> self a -> a) + (Nat -> Nat) + (\(s : + (\a -> ifix (\(self :: * -> *) a -> self a -> a) a) + (Nat -> Nat)) + (n : Nat) -> + match_Nat n {Nat} Zero (\(p : Nat) -> unwrap s s p))) + (Suc (Suc (Suc Zero)))) + {ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])} + (iwrap + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat]) + (constr + (sop [] - [(ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ]) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - )] - ) - 0 - ) - ) - ] - (lam - arg_0_i0 - (ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ]) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - ) - (iwrap - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ]) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) + [ (ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])) ]) + 0 + [])) + (\(arg_0 : + ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])) -> + iwrap + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat]) (constr - (sop - [] - [(ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ]) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - )] - ) - 1 - arg_0_i1 - ) - ) - ) - ] - (lam - x_i0 - (ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ]) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - ) - (abs - out_Nat_i0 - (type) - (lam - case_Zero_i0 - out_Nat_i2 - (lam - case_Suc_i0 - (fun - (ifix - (lam - rec_i0 - (fun (fun (type) (type)) (type)) - (lam f_i0 (fun (type) (type)) [ f_i1 [ rec_i2 f_i1 ] ]) - ) - (lam Nat_i0 (type) (sop [] [Nat_i1])) - ) - out_Nat_i3 - ) - (case out_Nat_i3 (unwrap x_i4) case_Zero_i2 case_Suc_i1) - ) - ) - ) - ) - ] -) \ No newline at end of file + (sop + [] + [ (ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])) ]) + 1 + [arg_0])) + (\(x : + ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat])) -> + /\out_Nat -> + \(case_Zero : out_Nat) + (case_Suc : + ifix + (\(rec :: (* -> *) -> *) (f :: * -> *) -> f (rec f)) + (\Nat -> sop [] [Nat]) -> + out_Nat) -> + case out_Nat (unwrap x) [case_Zero, case_Suc])) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprinting/basic.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprinting/basic.golden index 3d6340fb9a9..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprinting/basic.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprinting/basic.golden @@ -1 +1 @@ -(abs a (type) (lam x a x)) \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprinting/maybe.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprinting/maybe.golden index 8ec9701158c..c4a8b8e4eb5 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprinting/maybe.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprinting/maybe.golden @@ -1,12 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - [ { Just (all a (type) (fun a a)) } (abs a (type) (lam x a x)) ] -) \ No newline at end of file +let + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +Just {all a. a -> a} (/\a -> \(x : a) -> x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/basic.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/basic.golden index 5f9b4260a33..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/basic.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/basic.golden @@ -1 +1 @@ -/\a_0 -> \(x_1 : a_0) -> x_1 \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/errorBinding.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/errorBinding.golden index 1f137848b16..0e299cbab88 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/errorBinding.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/errorBinding.golden @@ -1,5 +1,5 @@ letrec - !x_0 : integer = error {integer} - ~y_1 : integer = x_0 + !x : integer = error {integer} + ~y : integer = x in 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/even3.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/even3.golden index dc7be50d683..76693e26deb 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/even3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/even3.golden @@ -1,20 +1,18 @@ letrec - data Nat_0 | match_Nat_1 where - Zero_2 : Nat_0 - Suc_3 : Nat_0 -> Nat_0 + data Nat | match_Nat where + Zero : Nat + Suc : Nat -> Nat in let - data Bool_4 | match_Bool_5 where - True_6 : Bool_4 - False_7 : Bool_4 - !three_8 : Nat_0 = Suc_3 (Suc_3 (Suc_3 Zero_2)) + data Bool | match_Bool where + True : Bool + False : Bool + !three : Nat = Suc (Suc (Suc Zero)) in letrec - !even_9 : Nat_0 -> Bool_4 - = \(n_10 : Nat_0) -> - match_Nat_1 n_10 {Bool_4} True_6 (\(pred_11 : Nat_0) -> odd_12 pred_11) - !odd_12 : Nat_0 -> Bool_4 - = \(n_10 : Nat_0) -> - match_Nat_1 n_10 {Bool_4} False_7 (\(pred_11 : Nat_0) -> even_9 pred_11) + !even : Nat -> Bool + = \(n : Nat) -> match_Nat n {Bool} True (\(pred : Nat) -> odd pred) + !odd : Nat -> Bool + = \(n : Nat) -> match_Nat n {Bool} False (\(pred : Nat) -> even pred) in -even_9 three_8 \ No newline at end of file +even three \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/idleAll.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/idleAll.golden index d9ef48b7461..a71a1dc068a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/idleAll.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/idleAll.golden @@ -1,7 +1,7 @@ let - data (D1_0 :: * -> *) a_1 | match_D1_2 where - C1_3 : D1_0 a_1 - data (D2_4 :: * -> *) a_1 | match_D2_5 where - C2_6 : all a_1. D2_4 a_1 + data (D1 :: * -> *) a | match_D1 where + C1 : D1 a + data (D2 :: * -> *) a | match_D2 where + C2 : all a. D2 a in -/\a_1 -> \(x_7 : a_1) -> x_7 \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/letDep.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/letDep.golden index 8c0283f141b..f37ce8f3365 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/letDep.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/letDep.golden @@ -1,5 +1,5 @@ let - !i_0 : integer = 3 - !j_1 : integer = i_0 + !i : integer = 3 + !j : integer = i in -j_1 \ No newline at end of file +j \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/letInLet.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/letInLet.golden index 471517a6d1f..c991386c1b4 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/letInLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/letInLet.golden @@ -1,8 +1,8 @@ let - !unitval2_0 : all a_1. a_1 -> a_1 + !unitval2 : all a. a -> a = let - !unitval_2 : all a_1. a_1 -> a_1 = /\a_1 -> \(x_3 : a_1) -> x_3 + !unitval : all a. a -> a = /\a -> \(x : a) -> x in - unitval_2 + unitval in -unitval2_0 \ No newline at end of file +unitval2 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/listMatch.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/listMatch.golden index 3a0ea343852..9d45a2ee620 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/listMatch.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/listMatch.golden @@ -1,12 +1,11 @@ letrec - data (List_0 :: * -> *) a_1 | match_List_2 where - Nil_3 : List_0 a_1 - Cons_4 : a_1 -> List_0 a_1 -> List_0 a_1 + data (List :: * -> *) a | match_List where + Nil : List a + Cons : a -> List a -> List a in -match_List_2 - {all a_1. a_1 -> a_1} - (Nil_3 {all a_1. a_1 -> a_1}) - {all a_1. a_1 -> a_1} - (/\a_1 -> \(x_5 : a_1) -> x_5) - (\(head_6 : all a_1. a_1 -> a_1) (tail_7 : List_0 (all a_1. a_1 -> a_1)) -> - head_6) \ No newline at end of file +match_List + {all a. a -> a} + (Nil {all a. a -> a}) + {all a. a -> a} + (/\a -> \(x : a) -> x) + (\(head : all a. a -> a) (tail : List (all a. a -> a)) -> head) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/maybe.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/maybe.golden index 767b52869cb..c4a8b8e4eb5 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/maybe.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/maybe.golden @@ -1,6 +1,6 @@ let - data (Maybe_0 :: * -> *) a_1 | match_Maybe_2 where - Nothing_3 : Maybe_0 a_1 - Just_4 : a_1 -> Maybe_0 a_1 + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a in -Just_4 {all a_1. a_1 -> a_1} (/\a_1 -> \(x_5 : a_1) -> x_5) \ No newline at end of file +Just {all a. a -> a} (/\a -> \(x : a) -> x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/mutuallyRecursiveValues.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/mutuallyRecursiveValues.golden index 8b230f93cc1..cd10561b364 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/mutuallyRecursiveValues.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/mutuallyRecursiveValues.golden @@ -1,5 +1,5 @@ letrec - !x_0 : all a_1. a_1 -> a_1 = y_2 - !y_2 : all a_1. a_1 -> a_1 = /\a_1 -> \(z_3 : a_1) -> x_0 {a_1} z_3 + !x : all a. a -> a = y + !y : all a. a -> a = /\a -> \(z : a) -> x {a} z in -x_0 \ No newline at end of file +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/recursiveTypeBind.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/recursiveTypeBind.golden index 3a575550666..d06ae6e3427 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/recursiveTypeBind.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/recursiveTypeBind.golden @@ -1,7 +1,7 @@ letrec - unit_0 = all a_1. unit_0 -> unit_0 + unit = all a. unit -> unit in let - !lazyVal_2 : unit_0 -> integer = \(x_3 : unit_0) -> 3 + !lazyVal : unit -> integer = \(x : unit) -> 3 in -lazyVal_2 \ No newline at end of file +lazyVal \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/some.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/some.golden index 749e270d9e4..7371b96b918 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/some.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/some.golden @@ -1,5 +1,5 @@ let - data (Some_0 :: (* -> *) -> *) (f_1 :: * -> *) | match_Some_2 where - MkSome_3 : all a_4. f_1 a_4 -> Some_0 f_1 + data (Some :: (* -> *) -> *) (f :: * -> *) | match_Some where + MkSome : all a. f a -> Some f in -/\a_4 -> \(x_5 : a_4) -> x_5 \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/stupidZero.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/stupidZero.golden index 68241cf5f71..716b4ae0082 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/stupidZero.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/prettyprintingReadable/stupidZero.golden @@ -1,18 +1,13 @@ letrec - data Nat_0 | match_Nat_1 where - Zero_2 : Nat_0 - Suc_3 : Nat_0 -> Nat_0 + data Nat | match_Nat where + Zero : Nat + Suc : Nat -> Nat in let - !three_4 : Nat_0 = Suc_3 (Suc_3 (Suc_3 Zero_2)) + !three : Nat = Suc (Suc (Suc Zero)) in letrec - !stupidZero_5 : Nat_0 -> Nat_0 - = \(n_6 : Nat_0) -> - match_Nat_1 - n_6 - {Nat_0} - Zero_2 - (\(pred_7 : Nat_0) -> stupidZero_5 pred_7) + !stupidZero : Nat -> Nat + = \(n : Nat) -> match_Nat n {Nat} Zero (\(pred : Nat) -> stupidZero pred) in -stupidZero_5 three_4 \ No newline at end of file +stupidZero three \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeBasic.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeBasic.golden index 3d6340fb9a9..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeBasic.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeBasic.golden @@ -1 +1 @@ -(abs a (type) (lam x a x)) \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeEvenOdd.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeEvenOdd.golden index ac499378b6e..76693e26deb 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeEvenOdd.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeEvenOdd.golden @@ -1,45 +1,18 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl Nat (type)) - - match_Nat - (vardecl Zero Nat) (vardecl Suc (fun Nat Nat)) - ) - ) - (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind (strict) (vardecl three Nat) [ Suc [ Suc [ Suc Zero ] ] ]) - (let - (rec) - (termbind - (strict) - (vardecl even (fun Nat Bool)) - (lam - n - Nat - [ [ { [ match_Nat n ] Bool } True ] (lam pred Nat [ odd pred ]) ] - ) - ) - (termbind - (strict) - (vardecl odd (fun Nat Bool)) - (lam - n - Nat - [ [ { [ match_Nat n ] Bool } False ] (lam pred Nat [ even pred ]) ] - ) - ) - [ even three ] - ) - ) -) \ No newline at end of file +letrec + data Nat | match_Nat where + Zero : Nat + Suc : Nat -> Nat +in +let + data Bool | match_Bool where + True : Bool + False : Bool + !three : Nat = Suc (Suc (Suc Zero)) +in +letrec + !even : Nat -> Bool + = \(n : Nat) -> match_Nat n {Bool} True (\(pred : Nat) -> odd pred) + !odd : Nat -> Bool + = \(n : Nat) -> match_Nat n {Bool} False (\(pred : Nat) -> even pred) +in +even three \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeListMatch.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeListMatch.golden index f5098ea706b..9d45a2ee620 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeListMatch.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeListMatch.golden @@ -1,29 +1,11 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - match_List - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - [ - [ - { - [ - { match_List (all a (type) (fun a a)) } - { Nil (all a (type) (fun a a)) } - ] - (all a (type) (fun a a)) - } - (abs a (type) (lam x a x)) - ] - (lam - head - (all a (type) (fun a a)) - (lam tail [ List (all a (type) (fun a a)) ] head) - ) - ] -) \ No newline at end of file +letrec + data (List :: * -> *) a | match_List where + Nil : List a + Cons : a -> List a -> List a +in +match_List + {all a. a -> a} + (Nil {all a. a -> a}) + {all a. a -> a} + (/\a -> \(x : a) -> x) + (\(head : all a. a -> a) (tail : List (all a. a -> a)) -> head) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeMaybePirTerm.golden b/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeMaybePirTerm.golden index 8ec9701158c..c4a8b8e4eb5 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeMaybePirTerm.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Core/serialization/serializeMaybePirTerm.golden @@ -1,12 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - [ { Just (all a (type) (fun a a)) } (abs a (type) (lam x a x)) ] -) \ No newline at end of file +let + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +Just {all a. a -> a} (/\a -> \(x : a) -> x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Purity/builtinAppSaturated.golden b/plutus-core/plutus-ir/test/PlutusIR/Purity/builtinAppSaturated.golden index 7ff3cb02d39..f263e96caa4 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Purity/builtinAppSaturated.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Purity/builtinAppSaturated.golden @@ -1,3 +1,3 @@ pure work-free: 1 pure work-free: 2 -impure? maybe work?: (addInteger 1 2) \ No newline at end of file +impure? maybe work?: addInteger 1 2 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Purity/builtinAppUnsaturated.golden b/plutus-core/plutus-ir/test/PlutusIR/Purity/builtinAppUnsaturated.golden index 2b3f8f62141..9d43689b1fb 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Purity/builtinAppUnsaturated.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Purity/builtinAppUnsaturated.golden @@ -1,2 +1,2 @@ pure work-free: 1 -pure work-free: (addInteger 1) \ No newline at end of file +pure work-free: addInteger 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Purity/letFun.golden b/plutus-core/plutus-ir/test/PlutusIR/Purity/letFun.golden index a38098993a5..b691cad5a98 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Purity/letFun.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Purity/letFun.golden @@ -1,5 +1,5 @@ -pure work-free: (addInteger) -pure maybe work?: f +pure work-free: addInteger +pure maybe work?: f-0 pure work-free: 1 -pure maybe work?: (f 1) +pure maybe work?: f-0 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Purity/nestedLets1.golden b/plutus-core/plutus-ir/test/PlutusIR/Purity/nestedLets1.golden index 192577a539d..703b62ebc52 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Purity/nestedLets1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Purity/nestedLets1.golden @@ -1,6 +1,6 @@ -pure work-free: (\(x : integer) -> x) -pure work-free: (\(y : integer) -> y) -pure maybe work?: a -pure maybe work?: b -pure maybe work?: (a b) +pure work-free: \(x-1 : integer) -> x-1 +pure work-free: \(y-3 : integer) -> y-3 +pure maybe work?: a-0 +pure maybe work?: b-2 +pure maybe work?: a-0 b-2 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Purity/pureLet.golden b/plutus-core/plutus-ir/test/PlutusIR/Purity/pureLet.golden index ed499ec0868..c7b95998dfe 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Purity/pureLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Purity/pureLet.golden @@ -1,6 +1,6 @@ pure work-free: 2 pure work-free: 1 -pure maybe work?: (let - !x : integer = 2 +pure maybe work?: let + !x-0 : integer = 2 in -1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/absapp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/absapp.golden index eb1ac12f117..b9de3da4312 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/absapp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/absapp.golden @@ -1 +1,4 @@ -(let (nonrec) (typebind (tyvardecl a (type)) (con integer)) (lam x a x)) \ No newline at end of file +let + a = integer +in +\(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/lamapp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/lamapp.golden index cace21c7aca..a049fdd83aa 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/lamapp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/lamapp.golden @@ -1 +1,4 @@ -(let (nonrec) (termbind (strict) (vardecl y (con integer)) (con integer 1)) y) \ No newline at end of file +let + !y : integer = 1 +in +y \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/lamapp2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/lamapp2.golden index fc209688f51..eda40b1e5fa 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/lamapp2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/lamapp2.golden @@ -1,11 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl x (con integer)) - (let - (nonrec) (termbind (strict) (vardecl y (con integer)) (con integer 1)) y - ) - ) - x -) \ No newline at end of file +let + !x : integer = let !y : integer = 1 in y +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/multiapp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/multiapp.golden index 34381f2c541..176d3cee6a0 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/multiapp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/multiapp.golden @@ -1,11 +1,6 @@ -(let - (nonrec) - (termbind (strict) (vardecl x (con integer)) (con integer 1)) - (termbind - (strict) - (vardecl y (fun (con integer) (fun (con integer) (con integer)))) - (lam a (con integer) (lam b (con integer) (con integer 2))) - ) - (termbind (strict) (vardecl z (con integer)) (con integer 3)) - [ [ y x ] z ] -) \ No newline at end of file +let + !x : integer = 1 + !y : integer -> integer -> integer = \(a : integer) (b : integer) -> 2 + !z : integer = 3 +in +y x z \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/multilet.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/multilet.golden index 02230c95548..265efe579e2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/multilet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Beta/multilet.golden @@ -1,17 +1,10 @@ -(let - (nonrec) - (termbind (strict) (vardecl x (con integer)) (con integer 1)) - (let - (nonrec) - (termbind - (strict) - (vardecl y (fun (con integer) (fun (con integer) (con integer)))) - (lam a (con integer) (lam b (con integer) (con integer 2))) - ) - (let - (nonrec) - (termbind (strict) (vardecl z (con integer)) (con integer 3)) - [ [ y x ] z ] - ) - ) -) \ No newline at end of file +let + !x : integer = 1 +in +let + !y : integer -> integer -> integer = \(a : integer) (b : integer) -> 2 +in +let + !z : integer = 3 +in +y x z \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/basic.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/basic.golden index dc2d764ab4f..6fedf160e0c 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/basic.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/basic.golden @@ -1,40 +1,15 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - (lam +let + data Bool | match_Bool where + True : Bool + False : Bool + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +\(x : Maybe integer) -> + match_Maybe + {integer} x - [ Maybe (con integer) ] - [ - [ - { [ { match_Maybe (con integer) } x ] (con integer) } - [ - [ { [ match_Bool False ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ] - (lam - i - (con integer) - [ - [ { [ match_Bool True ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ) - ] - ) -) \ No newline at end of file + {integer} + (match_Bool False {integer} 1 0) + (\(i : integer) -> match_Bool True {integer} 1 0) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/builtinBool.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/builtinBool.golden index 12f9fadd368..41d6c2e48ff 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/builtinBool.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/builtinBool.golden @@ -1,36 +1,14 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - (lam +let + data Bool | match_Bool where + True : Bool + False : Bool + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +\(x : bool) -> + ifThenElse + {integer} x - (con bool) - [ - [ - [ { (builtin ifThenElse) (con integer) } x ] - [ - [ { [ match_Bool False ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ] - [ - [ { [ match_Bool True ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ] - ) -) \ No newline at end of file + (match_Bool False {integer} 1 0) + (match_Bool True {integer} 1 0) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/exponential.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/exponential.golden index 4305c3882e4..5b231a6056b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/exponential.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/exponential.golden @@ -1,110 +1,44 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - (lam +let + data Bool | match_Bool where + True : Bool + False : Bool + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +\(x : Maybe integer) -> + match_Maybe + {integer} x - [ Maybe (con integer) ] - [ - [ - { [ { match_Maybe (con integer) } x ] (con integer) } - [ - [ - { [ match_Bool False ] (con integer) } - [ - [ - { [ { match_Maybe (con integer) } x ] (con integer) } - [ - [ { [ match_Bool False ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ] - (lam - j - (con integer) - [ - [ { [ match_Bool True ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ) - ] - ] - [ - [ - { [ { match_Maybe (con integer) } x ] (con integer) } - [ - [ { [ match_Bool False ] (con integer) } (con integer 3) ] - (con integer 2) - ] - ] - (lam - k - (con integer) - [ - [ { [ match_Bool True ] (con integer) } (con integer 3) ] - (con integer 2) - ] - ) - ] - ] - ] - (lam - i - (con integer) - [ - [ - { [ match_Bool True ] (con integer) } - [ - [ - { [ { match_Maybe (con integer) } x ] (con integer) } - [ - [ { [ match_Bool False ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ] - (lam - j - (con integer) - [ - [ { [ match_Bool True ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ) - ] - ] - [ - [ - { [ { match_Maybe (con integer) } x ] (con integer) } - [ - [ { [ match_Bool False ] (con integer) } (con integer 3) ] - (con integer 2) - ] - ] - (lam - k - (con integer) - [ - [ { [ match_Bool True ] (con integer) } (con integer 3) ] - (con integer 2) - ] - ) - ] - ] - ) - ] - ) -) \ No newline at end of file + {integer} + (match_Bool + False + {integer} + (match_Maybe + {integer} + x + {integer} + (match_Bool False {integer} 1 0) + (\(j : integer) -> match_Bool True {integer} 1 0)) + (match_Maybe + {integer} + x + {integer} + (match_Bool False {integer} 3 2) + (\(k : integer) -> match_Bool True {integer} 3 2))) + (\(i : integer) -> + match_Bool + True + {integer} + (match_Maybe + {integer} + x + {integer} + (match_Bool False {integer} 1 0) + (\(j : integer) -> match_Bool True {integer} 1 0)) + (match_Maybe + {integer} + x + {integer} + (match_Bool False {integer} 3 2) + (\(k : integer) -> match_Bool True {integer} 3 2))) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/largeExpr.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/largeExpr.golden index 832e50aa1d8..6e5bb1d67df 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/largeExpr.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/largeExpr.golden @@ -1,45 +1,19 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - (lam +let + data Bool | match_Bool where + True : Bool + False : Bool + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +\(x : Maybe integer) -> + let + !k_caseOfCase : Bool -> integer + = \(scrutinee : Bool) -> match_Bool scrutinee {integer} 1 0 + in + match_Maybe + {integer} x - [ Maybe (con integer) ] - (let - (nonrec) - (termbind - (strict) - (vardecl k_caseOfCase (fun Bool (con integer))) - (lam - scrutinee - Bool - [ - [ { [ match_Bool scrutinee ] (con integer) } (con integer 1) ] - (con integer 0) - ] - ) - ) - [ - [ - { [ { match_Maybe (con integer) } x ] (con integer) } - [ k_caseOfCase [ (lam b Bool b) False ] ] - ] - (lam i (con integer) [ k_caseOfCase True ]) - ] - ) - ) -) \ No newline at end of file + {integer} + (k_caseOfCase ((\(b : Bool) -> b) False)) + (\(i : integer) -> k_caseOfCase True) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/twoTyArgs.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/twoTyArgs.golden index b721532b7e4..a5812e012b0 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/twoTyArgs.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/CaseOfCase/twoTyArgs.golden @@ -1,40 +1,15 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl d12 (fun (fun (type) (type)) (fun (type) (type)))) - (tyvardecl a3 (fun (type) (type))) (tyvardecl a10 (type)) - m11 - (vardecl c6 (fun (con unit) [ [ d12 a3 ] a10 ])) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl k_caseOfCase (fun [ [ d12 (con list) ] (con unit) ] (con unit))) - (lam - scrutinee - [ [ d12 (con list) ] (con unit) ] - [ - { [ { { m11 (con list) } (con unit) } scrutinee ] (con unit) } - (error (fun (con unit) (con unit))) - ] - ) - ) - [ - { - [ - { { m11 (con list) } (con unit) } - (error [ [ d12 (con list) ] (con unit) ]) - ] - (con unit) - } - (lam - x23 - (con unit) - [ k_caseOfCase (error [ [ d12 (con list) ] (con unit) ]) ] - ) - ] - ) -) \ No newline at end of file +let + data (d12 :: (* -> *) -> * -> *) (a3 :: * -> *) a10 | m11 where + c6 : unit -> d12 a3 a10 +in +let + !k_caseOfCase : d12 list unit -> unit + = \(scrutinee : d12 list unit) -> + m11 {list} {unit} scrutinee {unit} (error {unit -> unit}) +in +m11 + {list} + {unit} + (error {d12 list unit}) + {unit} + (\(x23 : unit) -> k_caseOfCase (error {d12 list unit})) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/builtinBinding.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/builtinBinding.golden index 3d6340fb9a9..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/builtinBinding.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/builtinBinding.golden @@ -1 +1 @@ -(abs a (type) (lam x a x)) \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeDead.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeDead.golden index 3d6340fb9a9..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeDead.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeDead.golden @@ -1 +1 @@ -(abs a (type) (lam x a x)) \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveConstr.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveConstr.golden index a74cea2f108..995ccfae865 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveConstr.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveConstr.golden @@ -1,12 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - Nothing -) \ No newline at end of file +let + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +Nothing \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveDestr.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveDestr.golden index d956fbe272b..59ba03f6f90 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveDestr.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveDestr.golden @@ -1,12 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - match_Maybe -) \ No newline at end of file +let + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +match_Maybe \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveType.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveType.golden index 81089321b1e..779ec2914d6 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveType.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/datatypeLiveType.golden @@ -1,8 +1,4 @@ -(let - (nonrec) - (typebind - (tyvardecl Maybe (fun (type) (type))) - (lam a (type) (all a (type) (fun a a))) - ) - (error [ Maybe (con integer) ]) -) \ No newline at end of file +let + Maybe :: * -> * = \a -> all a. a -> a +in +error {Maybe integer} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/etaBuiltinBinding.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/etaBuiltinBinding.golden index 3d6340fb9a9..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/etaBuiltinBinding.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/etaBuiltinBinding.golden @@ -1 +1 @@ -(abs a (type) (lam x a x)) \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nestedBindings.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nestedBindings.golden index f5b4e1bb4ed..259634906e2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nestedBindings.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nestedBindings.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl unitval (all a (type) (fun a a))) - (abs a (type) (lam x a x)) - ) - unitval -) \ No newline at end of file +let + !unitval : all a. a -> a = /\a -> \(x : a) -> x +in +unitval \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nestedBindingsIndirect.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nestedBindingsIndirect.golden index 4cf3c3efc2f..68d9288902e 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nestedBindingsIndirect.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nestedBindingsIndirect.golden @@ -1,16 +1,8 @@ -(let - (nonrec) - (typebind (tyvardecl unit (type)) (all a (type) (fun a a))) - (let - (nonrec) - (datatypebind - (datatype - (tyvardecl SomeType (type)) - - match_SomeType - (vardecl Constr (fun unit SomeType)) - ) - ) - [ Constr (error unit) ] - ) -) \ No newline at end of file +let + unit = all a. a -> a +in +let + data SomeType | match_SomeType where + Constr : unit -> SomeType +in +Constr (error {unit}) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nonstrictLet.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nonstrictLet.golden index f5b4e1bb4ed..259634906e2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nonstrictLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/nonstrictLet.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl unitval (all a (type) (fun a a))) - (abs a (type) (lam x a x)) - ) - unitval -) \ No newline at end of file +let + !unitval : all a. a -> a = /\a -> \(x : a) -> x +in +unitval \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/pruneDatatype.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/pruneDatatype.golden index 27168716a04..9157c00fb6d 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/pruneDatatype.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/pruneDatatype.golden @@ -1,9 +1,7 @@ -(let - (nonrec) - (typebind (tyvardecl unit (type)) (all a (type) (fun a a))) - (let - (nonrec) - (typebind (tyvardecl SomeType (type)) (all a (type) (fun a a))) - (lam arg SomeType (error unit)) - ) -) \ No newline at end of file +let + unit = all a. a -> a +in +let + SomeType = all a. a -> a +in +\(arg : SomeType) -> error {unit} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/recBindingComplex.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/recBindingComplex.golden index 04ea9ba236f..8d8bed52197 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/recBindingComplex.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/recBindingComplex.golden @@ -1,9 +1,4 @@ -(let - (rec) - (termbind - (strict) - (vardecl unitval (all a (type) (fun a a))) - (abs a (type) (lam x a x)) - ) - unitval -) \ No newline at end of file +letrec + !unitval : all a. a -> a = /\a -> \(x : a) -> x +in +unitval \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/recBindingSimple.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/recBindingSimple.golden index 3d6340fb9a9..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/recBindingSimple.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/recBindingSimple.golden @@ -1 +1 @@ -(abs a (type) (lam x a x)) \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/singleBinding.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/singleBinding.golden index f5b4e1bb4ed..259634906e2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/singleBinding.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/singleBinding.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl unitval (all a (type) (fun a a))) - (abs a (type) (lam x a x)) - ) - unitval -) \ No newline at end of file +let + !unitval : all a. a -> a = /\a -> \(x : a) -> x +in +unitval \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/strictLet.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/strictLet.golden index a0db8319f02..812ceb6ee85 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/strictLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/strictLet.golden @@ -1,17 +1,7 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl unitval (all a (type) (fun a a))) - (abs a (type) (lam x a x)) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl unitunit (all a (type) (fun a a))) - [ { unitval (all a (type) (fun a a)) } unitval ] - ) - unitval - ) -) \ No newline at end of file +let + !unitval : all a. a -> a = /\a -> \(x : a) -> x +in +let + !unitunit : all a. a -> a = unitval {all a. a -> a} unitval +in +unitval \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/termLet.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/termLet.golden index 3d6340fb9a9..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/termLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/termLet.golden @@ -1 +1 @@ -(abs a (type) (lam x a x)) \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/typeLet.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/typeLet.golden index 3d6340fb9a9..e9659c2c4ef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/typeLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/DeadCode/typeLet.golden @@ -1 +1 @@ -(abs a (type) (lam x a x)) \ No newline at end of file +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/addInteger.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/addInteger.golden index 7ce41fb5eca..e440e5c8425 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/addInteger.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/addInteger.golden @@ -1 +1 @@ -(con integer 3) \ No newline at end of file +3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/failingBuiltin.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/failingBuiltin.golden index 39e5fae3c53..1f11dc4236f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/failingBuiltin.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/failingBuiltin.golden @@ -1 +1 @@ -[ [ (builtin divideInteger) (con integer 1) ] (con integer 0) ] \ No newline at end of file +divideInteger 1 0 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/ifThenElse.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/ifThenElse.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/ifThenElse.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/ifThenElse.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/nonConstantArg.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/nonConstantArg.golden index 6c939148178..aa9e1d061cf 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/nonConstantArg.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/nonConstantArg.golden @@ -1,5 +1,4 @@ -(let - (nonrec) - (termbind (strict) (vardecl x (con integer)) (con integer 1)) - [ [ (builtin addInteger) x ] (con integer 2) ] -) \ No newline at end of file +let + !x : integer = 1 +in +addInteger x 2 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/overApplication.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/overApplication.golden index bffb2f00dde..fe4a8f5f62f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/overApplication.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/overApplication.golden @@ -1 +1 @@ -[ (lam x (con integer) (con integer 1)) (con integer 3) ] \ No newline at end of file +(\(x : integer) -> 1) 3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceConservative.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceConservative.golden index bb0268e2db2..19419c43a8f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceConservative.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceConservative.golden @@ -1 +1 @@ -[ [ { (builtin trace) (con integer) } (con string "hello") ] (con integer 1) ] \ No newline at end of file +trace {integer} "hello" 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceNonConservative.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceNonConservative.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceNonConservative.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/traceNonConservative.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressAndEqualBlsNonConservative.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressAndEqualBlsNonConservative.golden index ba9e9f50707..f742d389cdb 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressAndEqualBlsNonConservative.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressAndEqualBlsNonConservative.golden @@ -1,19 +1,5 @@ -[ - [ - (builtin bls12_381_G1_equal) - [ - (builtin bls12_381_G1_uncompress) - (con - bytestring - #97f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb - ) - ] - ] - [ - (builtin bls12_381_G1_uncompress) - (con - bytestring - #97f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb - ) - ] -] \ No newline at end of file +bls12_381_G1_equal + (bls12_381_G1_uncompress + #97f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb) + (bls12_381_G1_uncompress + #97f1d3a73197d7942695638c4fa9ac0fc3688c4f9774b905a14e3a3f171bac586c55e83ff97a1aeffb3af00adb22c6bb) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsConservative.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsConservative.golden index 1238bc334e3..6b006da298a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsConservative.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsConservative.golden @@ -1,7 +1,2 @@ -[ - (builtin bls12_381_G2_uncompress) - (con - bytestring - #c00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 - ) -] \ No newline at end of file +bls12_381_G2_uncompress + #c00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsNonConservative.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsNonConservative.golden index 1238bc334e3..6b006da298a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsNonConservative.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/uncompressBlsNonConservative.golden @@ -1,7 +1,2 @@ -[ - (builtin bls12_381_G2_uncompress) - (con - bytestring - #c00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 - ) -] \ No newline at end of file +bls12_381_G2_uncompress + #c00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/underApplication.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/underApplication.golden index 6d483bdcb2a..51e72e82dd1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/underApplication.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/EvaluateBuiltins/underApplication.golden @@ -1 +1 @@ -[ (builtin addInteger) (con integer 1) ] \ No newline at end of file +addInteger 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/builtin.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/builtin.golden index c72b7968660..e883a50d5f5 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/builtin.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/builtin.golden @@ -1 +1 @@ -(builtin addInteger) \ No newline at end of file +addInteger \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/callsite-non-trivial-body.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/callsite-non-trivial-body.golden index 0c14cc2c40a..e11b5606bb8 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/callsite-non-trivial-body.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/callsite-non-trivial-body.golden @@ -1,71 +1,14 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl - f - (fun - (fun (con integer) (con integer)) - (fun - (fun (con integer) (fun (con integer) (con integer))) - (fun (con integer) (con integer)) - ) - ) - ) - (lam - unused - (fun (con integer) (con integer)) - (lam - a - (fun (con integer) (fun (con integer) (con integer))) - (lam - b - (con integer) - [ - [ a b ] - [ - [ - (builtin addInteger) - [ - [ - (builtin addInteger) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ] - (con integer 3) - ] - ] - (con integer 4) - ] - ] - ) - ) - ) - ) - [ - [ - (builtin addInteger) - [ - [ - [ f (lam unused (con integer) (con integer 5)) ] (builtin addInteger) - ] - (con integer 6) - ] - ] - [ - [ (builtin addInteger) (con integer 11) ] - [ - [ - (builtin addInteger) - [ - [ - (builtin addInteger) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ] - (con integer 3) - ] - ] - (con integer 4) - ] - ] - ] -) \ No newline at end of file +let + !f : + (integer -> integer) -> + (integer -> integer -> integer) -> + integer -> + integer + = \(unused : integer -> integer) + (a : integer -> integer -> integer) + (b : integer) -> + a b (addInteger (addInteger (addInteger 1 2) 3) 4) +in +addInteger + (f (\(unused : integer) -> 5) addInteger 6) + (addInteger 11 (addInteger (addInteger (addInteger 1 2) 3) 4)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/constant.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/constant.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/constant.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/constant.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/effectfulBuiltinArg.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/effectfulBuiltinArg.golden index 7b56bf75458..bfa6f0e8f5f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/effectfulBuiltinArg.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/effectfulBuiltinArg.golden @@ -1,29 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl x (con integer)) - [ - [ { (builtin trace) (con integer) } (con string "msg2") ] (con integer 1) - ] - ) - [ - [ - [ - { (builtin ifThenElse) (con integer) } - [ - [ - (builtin equalsInteger) - [ - [ { (builtin trace) (con integer) } (con string "msg1") ] - (con integer 0) - ] - ] - x - ] - ] - (con integer 9) - ] - (con integer 10) - ] -) \ No newline at end of file +let + !x : integer = trace {integer} "msg2" 1 +in +ifThenElse {integer} (equalsInteger (trace {integer} "msg1" 0) x) 9 10 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/firstEffectfulTerm1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/firstEffectfulTerm1.golden index 0ff66b05e7f..de51762c72f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/firstEffectfulTerm1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/firstEffectfulTerm1.golden @@ -1 +1 @@ -[ (lam x (con integer) x) (error (con integer)) ] \ No newline at end of file +(\(x : integer) -> x) (error {integer}) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/firstEffectfulTerm2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/firstEffectfulTerm2.golden index 3243f358548..865c9b79e79 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/firstEffectfulTerm2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/firstEffectfulTerm2.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl a (fun (con integer) (con integer))) - (error (fun (con integer) (con integer))) - ) - [ a [ (lam x (con integer) x) (error (con integer)) ] ] -) \ No newline at end of file +let + !a : integer -> integer = error {integer -> integer} +in +a ((\(x : integer) -> x) (error {integer})) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/immediateApp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/immediateApp.golden index 36e97458623..82ffcf38413 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/immediateApp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/immediateApp.golden @@ -1 +1 @@ -[ (error (fun (con integer) (con integer))) (con integer 1) ] \ No newline at end of file +error {integer -> integer} 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/immediateVar.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/immediateVar.golden index 3888d41dbbb..66d5392804d 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/immediateVar.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/immediateVar.golden @@ -1 +1 @@ -(error (con integer)) \ No newline at end of file +error {integer} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/inlineConstantsOff.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/inlineConstantsOff.golden index 3069793dd8d..699d88ad2d6 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/inlineConstantsOff.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/inlineConstantsOff.golden @@ -1,5 +1,4 @@ -(let - (nonrec) - (termbind (strict) (vardecl x (con integer)) (con integer 3)) - [ [ (builtin addInteger) x ] [ [ (builtin addInteger) x ] (con integer 5) ] ] -) \ No newline at end of file +let + !x : integer = 3 +in +addInteger x (addInteger x 5) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/inlineConstantsOn.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/inlineConstantsOn.golden index 89dbd9e691c..4a6e6aba8c3 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/inlineConstantsOn.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/inlineConstantsOn.golden @@ -1,4 +1 @@ -[ - [ (builtin addInteger) (con integer 3) ] - [ [ (builtin addInteger) (con integer 3) ] (con integer 5) ] -] \ No newline at end of file +addInteger 3 (addInteger 3 5) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letApp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letApp.golden index 041217b9881..5b896ef99c4 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letApp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letApp.golden @@ -1 +1 @@ -[ [ (builtin addInteger) (con integer 4) ] (con integer 5) ] \ No newline at end of file +addInteger 4 5 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letAppMultiNotAcceptable.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letAppMultiNotAcceptable.golden index d17eb5b9a73..5b687b94487 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letAppMultiNotAcceptable.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letAppMultiNotAcceptable.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl funApp (fun (con integer) (con integer))) - (lam x (con integer) [ [ (builtin addInteger) (con integer 4) ] x ]) - ) - [ funApp (con integer 4) ] -) \ No newline at end of file +let + !funApp : integer -> integer = \(x : integer) -> addInteger 4 x +in +funApp 4 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstBool.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstBool.golden index a3d50a9046c..46fb66d272d 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstBool.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstBool.golden @@ -1,12 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - [ [ (lam x (con integer) (lam y Bool x)) (con integer 3) ] False ] -) \ No newline at end of file +let + data Bool | Bool_match where + True : Bool + False : Bool +in +(\(x : integer) (y : Bool) -> x) 3 False \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstInt.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstInt.golden index a366d3a4da7..5a02300e33a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstInt.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstInt.golden @@ -1,4 +1 @@ -[ - [ (lam x (con integer) (lam y (con integer) x)) (con integer 3) ] - (con integer 4) -] \ No newline at end of file +(\(x : integer) (y : integer) -> x) 3 4 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstMulti.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstMulti.golden index b648c0e4151..b50e7ff3cd8 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstMulti.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunConstMulti.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl constFun (fun (con integer) (fun (con integer) (con integer)))) - (lam x (con integer) (lam y (con integer) x)) - ) - (lam y (con integer) (con integer 3)) -) \ No newline at end of file +let + !constFun : integer -> integer -> integer = \(x : integer) (y : integer) -> x +in +\(y : integer) -> 3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunInFun.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunInFun.golden index 97b75d43eae..c021f30f69e 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunInFun.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunInFun.golden @@ -1 +1 @@ -[ (lam y (con integer) (lam x (con integer) x)) (con integer 3) ] \ No newline at end of file +(\(y : integer) (x : integer) -> x) 3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunInFunMulti.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunInFunMulti.golden index 100f62f5844..300fd124a1d 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunInFunMulti.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letFunInFunMulti.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl idFun (fun (con integer) (con integer))) - (lam x (con integer) x) - ) - [ (lam y (fun (con integer) (con integer)) idFun) idFun ] -) \ No newline at end of file +let + !idFun : integer -> integer = \(x : integer) -> x +in +(\(y : integer -> integer) -> idFun) idFun \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPure.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPure.golden index 1755afde328..13e92e3cfb1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPure.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPure.golden @@ -1,11 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl x (con integer)) - [ - [ { (builtin trace) (con integer) } (con string "hello") ] (con integer 1) - ] - ) - [ [ (builtin addInteger) x ] x ] -) \ No newline at end of file +let + !x : integer = trace {integer} "hello" 1 +in +addInteger x x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPureMulti.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPureMulti.golden index 7668057a126..5a96253997f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPureMulti.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPureMulti.golden @@ -1,15 +1,7 @@ -(let - (nonrec) - (termbind - (nonstrict) - (vardecl y (con integer)) - [ - [ { (builtin trace) (con integer) } (con string "hello") ] (con integer 1) - ] - ) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) y) - [ [ (builtin addInteger) y ] [ [ (builtin addInteger) x ] x ] ] - ) -) \ No newline at end of file +let + ~y : integer = trace {integer} "hello" 1 +in +let + !x : integer = y +in +addInteger y (addInteger x x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPureMultiStrict.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPureMultiStrict.golden index 3c39cc4336b..4ab5a2db8d3 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPureMultiStrict.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letNonPureMultiStrict.golden @@ -1,11 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl y (con integer)) - [ - [ { (builtin trace) (con integer) } (con string "hello") ] (con integer 1) - ] - ) - [ [ (builtin addInteger) y ] [ [ (builtin addInteger) y ] y ] ] -) \ No newline at end of file +let + !y : integer = trace {integer} "hello" 1 +in +addInteger y (addInteger y y) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverApp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverApp.golden index 6c902fc3d01..19210214f57 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverApp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverApp.golden @@ -1,4 +1 @@ -[ - [ (lam x (con integer) (lam y (con integer) y)) (con integer 5) ] - (con integer 6) -] \ No newline at end of file +(\(x : integer) (y : integer) -> y) 5 6 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverAppMulti.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverAppMulti.golden index c9becf00ff5..24e4947e17c 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverAppMulti.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverAppMulti.golden @@ -1,22 +1,8 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl idFun (fun (con integer) (con integer))) - (lam y (con integer) y) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl - k - (fun - (fun (con integer) (con integer)) (fun (con integer) (con integer)) - ) - ) - (lam x (fun (con integer) (con integer)) idFun) - ) - [ idFun (con integer 6) ] - ) -) \ No newline at end of file +let + !idFun : integer -> integer = \(y : integer) -> y +in +let + !k : (integer -> integer) -> integer -> integer + = \(x : integer -> integer) -> idFun +in +idFun 6 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverAppType.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverAppType.golden index 2be13821dc3..bfb81e53fc2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverAppType.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letOverAppType.golden @@ -1,7 +1,4 @@ -(let - (nonrec) - (termbind - (strict) (vardecl idFun (all a (type) (fun a a))) (abs a (type) (lam x a x)) - ) - (con integer 3) -) \ No newline at end of file +let + !idFun : all a. a -> a = /\a -> \(x : a) -> x +in +3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeApp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeApp.golden index 397607c5d7a..805f1f07fe2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeApp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeApp.golden @@ -1 +1 @@ -[ { (abs a (type) (lam x a x)) (con integer) } (con integer 3) ] \ No newline at end of file +(/\a -> \(x : a) -> x) {integer} 3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeApp2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeApp2.golden index 9b49cbafca9..11e7e1dcc34 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeApp2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeApp2.golden @@ -1,10 +1,4 @@ -(let - (nonrec) - (termbind - (strict) (vardecl idFun (all a (type) (fun a a))) (abs a (type) (lam x a x)) - ) - [ - (lam x (con integer) x) - [ (lam x (con integer) x) [ (lam x (con integer) x) (con integer 3) ] ] - ] -) \ No newline at end of file +let + !idFun : all a. a -> a = /\a -> \(x : a) -> x +in +(\(x : integer) -> x) ((\(x : integer) -> x) ((\(x : integer) -> x) 3)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMulti.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMulti.golden index 0accbc167a4..f17c74aca43 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMulti.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMulti.golden @@ -1,7 +1,4 @@ -(let - (nonrec) - (termbind - (strict) (vardecl idFun (all a (type) (fun a a))) (abs a (type) (lam x a x)) - ) - [ [ (builtin addInteger) (con integer 3) ] (con integer 3) ] -) \ No newline at end of file +let + !idFun : all a. a -> a = /\a -> \(x : a) -> x +in +addInteger 3 3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMultiNotSat.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMultiNotSat.golden index fa4b115419e..e7fe6b91534 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMultiNotSat.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMultiNotSat.golden @@ -1,7 +1,4 @@ -(let - (nonrec) - (termbind - (strict) (vardecl idFun (all a (type) (fun a a))) (abs a (type) (lam x a x)) - ) - (lam x (con integer) x) -) \ No newline at end of file +let + !idFun : all a. a -> a = /\a -> \(x : a) -> x +in +\(x : integer) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMultiSat.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMultiSat.golden index 2796be03a18..cbda4d1c148 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMultiSat.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/letTypeAppMultiSat.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl idFun (fun (con integer) (con integer))) - (lam x (con integer) x) - ) - [ [ (lam y (fun (con integer) (con integer)) idFun) idFun ] (con integer 1) ] -) \ No newline at end of file +let + !idFun : integer -> integer = \(x : integer) -> x +in +(\(y : integer -> integer) -> idFun) idFun 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/multilet.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/multilet.golden index 2e82f313700..d7d474b3921 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/multilet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/multilet.golden @@ -1,27 +1,8 @@ -(lam - n - (con integer) - (let - (nonrec) - (termbind - (strict) - (vardecl x (con integer)) - [ - [ { (builtin trace) (con integer) } (con string "effect_x") ] - [ [ (builtin addInteger) (con integer 1) ] n ] - ] - ) - (let - (nonrec) - (termbind - (strict) - (vardecl y (con integer)) - [ - [ { (builtin trace) (con integer) } (con string "effect_y") ] - [ [ (builtin addInteger) (con integer 2) ] n ] - ] - ) - [ [ (builtin addInteger) x ] [ [ (builtin addInteger) y ] y ] ] - ) - ) -) \ No newline at end of file +\(n : integer) -> + let + !x : integer = trace {integer} "effect_x" (addInteger 1 n) + in + let + !y : integer = trace {integer} "effect_y" (addInteger 2 n) + in + addInteger x (addInteger y y) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/nameCapture.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/nameCapture.golden index cd3e98f3de2..c14514670f3 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/nameCapture.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/nameCapture.golden @@ -1,15 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl c (con integer)) - [ [ (builtin addInteger) (con integer 10) ] (con integer 10) ] - ) - [ - [ - (builtin addInteger) - [ [ (builtin addInteger) (con integer 10) ] (con integer 7) ] - ] - (con integer 7) - ] -) \ No newline at end of file +let + !c : integer = addInteger 10 10 +in +addInteger (addInteger 10 7) 7 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/partiallyApp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/partiallyApp.golden index be3e5be4c62..1137f20b4f4 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/partiallyApp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/partiallyApp.golden @@ -1,25 +1,5 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl - f - (fun - (con integer) - (fun - (con integer) (fun (con integer) (fun (con integer) (con integer))) - ) - ) - ) - (lam - a - (con integer) - (lam - b - (con integer) - (lam c (con integer) (lam d (con integer) (con integer 5))) - ) - ) - ) - (lam d (con integer) (con integer 5)) -) \ No newline at end of file +let + !f : integer -> integer -> integer -> integer -> integer + = \(a : integer) (b : integer) (c : integer) (d : integer) -> 5 +in +\(d : integer) -> 5 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/rhs-modified.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/rhs-modified.golden index 48d13734d31..8b69430724f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/rhs-modified.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/rhs-modified.golden @@ -1,13 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl f (fun (con integer) (con integer))) - (lam - x - (con integer) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - ) - [ [ (builtin addInteger) [ f (con integer 3) ] ] [ f (con integer 4) ] ] -) \ No newline at end of file +let + !f : integer -> integer = \(x : integer) -> addInteger 1 2 +in +addInteger (f 3) (f 4) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/single.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/single.golden index c302b6f7eae..ae5a2b7691f 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/single.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/single.golden @@ -1,17 +1,7 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl simple (con integer)) - [ (lam y (con integer) y) (con integer 1) ] - ) - (let - (nonrec) - (termbind - (strict) - (vardecl variableCapture (con integer)) - [ (lam y (con integer) (con integer 42)) (con integer 24) ] - ) - (con integer 42) - ) -) \ No newline at end of file +let + !simple : integer = (\(y : integer) -> y) 1 +in +let + !variableCapture : integer = (\(y : integer) -> 42) 24 +in +42 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/transitive.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/transitive.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/transitive.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/transitive.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/tyvar.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/tyvar.golden index e0d12f496dd..a628e947f80 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/tyvar.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/tyvar.golden @@ -1 +1 @@ -(lam p (con integer) (lam z (con integer) [ (lam x (con integer) x) p ])) \ No newline at end of file +\(p : integer) (z : integer) -> (\(x : integer) -> x) p \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/var.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/var.golden index f3f6b9174bd..20419b689ac 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/var.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Inline/var.golden @@ -1 +1 @@ -(lam y (con integer) y) \ No newline at end of file +\(y : integer) -> y \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/applicative.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/applicative.golden index b8937235fce..ef56e978bb3 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/applicative.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/applicative.golden @@ -1,118 +1,34 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - (termbind - (strict) - (vardecl x [ Maybe (con integer) ]) - [ { Just (con integer) } (con integer 1) ] - ) - (termbind - (strict) - (vardecl ds1 [ Maybe (fun (con integer) (con integer)) ]) - [ - [ - [ - (let - (nonrec) - (typebind (tyvardecl b (type)) (fun (con integer) (con integer))) - (lam - dFunctor - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - Maybe - ] - (lam - f - (fun (con integer) b) - (lam - fa - [ Maybe (con integer) ] - [ [ { { dFunctor (con integer) } b } f ] fa ] - ) - ) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a b) - (lam - ds2 - [ Maybe a ] - { - [ - [ - { - [ { Maybe_match a } ds2 ] - (all dead (type) [ Maybe b ]) - } - (lam a a (abs dead (type) [ { Just b } [ f a ] ])) - ] - (abs dead (type) { Nothing b }) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ] - (lam - p (con integer) (lam q (con integer) [ [ (builtin addInteger) p ] q ]) - ) - ] - x - ] - ) - { - [ - [ - { - [ { Maybe_match (fun (con integer) (con integer)) } ds1 ] - (all dead (type) [ Maybe (con integer) ]) - } - (lam - g - (fun (con integer) (con integer)) - (abs - dead - (type) - { - [ - (lam - v - (con integer) - (abs dead (type) [ { Just (con integer) } [ g v ] ]) - ) - (con integer 2) - ] - (all dead (type) dead) - } - ) - ) - ] - (abs dead (type) { Nothing (con integer) }) - ] - (all dead (type) dead) - } -) \ No newline at end of file +let + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + !x : Maybe integer = Just {integer} 1 + !ds1 : Maybe (integer -> integer) + = (let + b = integer -> integer + in + \(dFunctor : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) Maybe) + (f : integer -> b) + (fa : Maybe integer) -> + dFunctor {integer} {b} f fa) + (/\a b -> + \(f : a -> b) (ds2 : Maybe a) -> + Maybe_match + {a} + ds2 + {all dead. Maybe b} + (\(a : a) -> /\dead -> Just {b} (f a)) + (/\dead -> Nothing {b}) + {all dead. dead}) + (\(p : integer) (q : integer) -> addInteger p q) + x +in +Maybe_match + {integer -> integer} + ds1 + {all dead. Maybe integer} + (\(g : integer -> integer) -> + /\dead -> + (\(v : integer) -> /\dead -> Just {integer} (g v)) 2 {all dead. dead}) + (/\dead -> Nothing {integer}) + {all dead. dead} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/bool.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/bool.golden index 7daa7229a94..44dcaaf17e2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/bool.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/bool.golden @@ -1,12 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - { (abs dead (type) (con integer 1)) (all dead (type) dead) } -) \ No newline at end of file +let + data Bool | Bool_match where + True : Bool + False : Bool +in +(/\dead -> 1) {all dead. dead} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/list.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/list.golden index a80a6de4fd2..f1430f3308d 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/list.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/list.golden @@ -1,30 +1,9 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - { - [ - [ - (lam - a - (con integer) - (lam - as - [ List (con integer) ] - (abs dead (type) [ [ (builtin addInteger) (con integer 2) ] a ]) - ) - ) - (con integer 1) - ] - { Nil (con integer) } - ] - (all dead (type) dead) - } -) \ No newline at end of file +letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a +in +(\(a : integer) (as : List integer) -> /\dead -> addInteger 2 a) + 1 + (Nil {integer}) + {all dead. dead} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-just-unsaturated.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-just-unsaturated.golden index 1985d01dc07..597bce16adf 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-just-unsaturated.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-just-unsaturated.golden @@ -1,24 +1,10 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - [ - { - [ - { Maybe_match (con integer) } [ { Just (con integer) } (con integer 1) ] - ] - (all dead (type) (con integer)) - } - (lam - a - (con integer) - (abs dead (type) [ [ (builtin addInteger) (con integer 2) ] a ]) - ) - ] -) \ No newline at end of file +let + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a +in +Maybe_match + {integer} + (Just {integer} 1) + {all dead. integer} + (\(a : integer) -> /\dead -> addInteger 2 a) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-just.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-just.golden index 294f1efefe7..131b7cf0a8c 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-just.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-just.golden @@ -1,22 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - { - [ - (lam - a - (con integer) - (abs dead (type) [ [ (builtin addInteger) (con integer 2) ] a ]) - ) - (con integer 1) - ] - (all dead (type) dead) - } -) \ No newline at end of file +let + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a +in +(\(a : integer) -> /\dead -> addInteger 2 a) 1 {all dead. dead} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-nothing.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-nothing.golden index 937de0bc4d0..44d361d4efa 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-nothing.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/maybe-nothing.golden @@ -1,12 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - { (abs dead (type) (con integer 42)) (all dead (type) dead) } -) \ No newline at end of file +let + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a +in +(/\dead -> 42) {all dead. dead} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/pair.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/pair.golden index 5f7c3241214..33f071ae397 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/pair.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/KnownCon/pair.golden @@ -1,27 +1,5 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - { - [ - [ - (lam - a - (con integer) - (lam - b (con integer) (abs dead (type) [ [ (builtin addInteger) a ] b ]) - ) - ) - (con integer 1) - ] - (con integer 2) - ] - (all dead (type) dead) - } -) \ No newline at end of file +let + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b +in +(\(a : integer) (b : integer) -> /\dead -> addInteger a b) 1 2 {all dead. dead} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/conservative/avoid-floating-into-lam.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/conservative/avoid-floating-into-lam.golden index 9c981eb3753..1388a6cb8f7 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/conservative/avoid-floating-into-lam.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/conservative/avoid-floating-into-lam.golden @@ -1,17 +1,8 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl f (fun (con integer) (con integer))) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - (lam y (con integer) [ [ (builtin addInteger) y ] x ]) - ) - ) - [ [ (builtin addInteger) [ f (con integer 1) ] ] [ f (con integer 2) ] ] -) \ No newline at end of file +let + !f : integer -> integer + = let + ~x : integer = addInteger 1 2 + in + \(y : integer) -> addInteger y x +in +addInteger (f 1) (f 2) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/conservative/avoid-floating-into-tyabs.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/conservative/avoid-floating-into-tyabs.golden index 570d62ff4c2..a267e41ef88 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/conservative/avoid-floating-into-tyabs.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/conservative/avoid-floating-into-tyabs.golden @@ -1,17 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl f (all t (type) (con integer))) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - (abs t (type) x) - ) - ) - [ [ (builtin addInteger) { f (con integer) } ] { f (con integer) } ] -) \ No newline at end of file +let + !f : all t. integer = let ~x : integer = addInteger 1 2 in /\t -> x +in +addInteger (f {integer}) (f {integer}) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/avoid-floating-into-RHS.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/avoid-floating-into-RHS.golden index 13e57053e85..3ee743b7282 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/avoid-floating-into-RHS.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/avoid-floating-into-RHS.golden @@ -1,12 +1,5 @@ -(let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - (termbind - (nonstrict) (vardecl y (con integer)) [ [ (builtin addInteger) x ] x ] - ) - [ [ (builtin addInteger) y ] y ] -) \ No newline at end of file +let + ~x : integer = addInteger 1 2 + ~y : integer = addInteger x x +in +addInteger y y \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/avoid-moving-strict-nonvalue-bindings.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/avoid-moving-strict-nonvalue-bindings.golden index b019d172db8..6ce78aa43a7 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/avoid-moving-strict-nonvalue-bindings.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/avoid-moving-strict-nonvalue-bindings.golden @@ -1,13 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl y (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - (lam - x - (con integer) - [ [ (builtin addInteger) [ [ (builtin addInteger) y ] x ] ] y ] - ) -) \ No newline at end of file +let + !y : integer = addInteger 1 2 +in +\(x : integer) -> addInteger (addInteger y x) y \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/cannot-float-into-app.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/cannot-float-into-app.golden index 3006d50483d..e96f8d382df 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/cannot-float-into-app.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/cannot-float-into-app.golden @@ -1,14 +1,5 @@ -(let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - (termbind - (strict) - (vardecl f (fun (con integer) (con integer))) - (lam y (con integer) [ [ (builtin addInteger) y ] (con integer 3) ]) - ) - [ [ (builtin addInteger) [ f x ] ] [ f x ] ] -) \ No newline at end of file +let + ~x : integer = addInteger 1 2 + !f : integer -> integer = \(y : integer) -> addInteger y 3 +in +addInteger (f x) (f x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/datatype1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/datatype1.golden index dc01d627469..c46bdb926b9 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/datatype1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/datatype1.golden @@ -1,18 +1,8 @@ -[ - { - (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - Just - ) - (all a (type) (fun a a)) - } - (abs a (type) (lam x a x)) -] \ No newline at end of file +(let + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a + in + Just) + {all a. a -> a} + (/\a -> \(x : a) -> x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/datatype2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/datatype2.golden index c502ba6c029..3fc50b47e82 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/datatype2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/datatype2.golden @@ -1,26 +1,7 @@ -(lam - x - (con integer) - (lam - y - (con integer) - (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - [ - [ - [ { (builtin ifThenElse) Bool } [ [ (builtin equalsInteger) x ] y ] ] - True - ] - False - ] - ) - ) -) \ No newline at end of file +\(x : integer) (y : integer) -> + let + data Bool | Bool_match where + True : Bool + False : Bool + in + ifThenElse {Bool} (equalsInteger x y) True False \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-RHS.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-RHS.golden index a419b389378..85b9f047189 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-RHS.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-RHS.golden @@ -1,23 +1,6 @@ -[ - [ - (builtin addInteger) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl y (con integer)) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - [ [ (builtin addInteger) x ] x ] - ) - ) - y - ) - ] - (con integer 3) -] \ No newline at end of file +addInteger + (let + ~y : integer = let ~x : integer = addInteger 1 2 in addInteger x x + in + y) + 3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-case-arg.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-case-arg.golden index 9dc39f06f3d..c0b65bf0958 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-case-arg.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-case-arg.golden @@ -1,17 +1,4 @@ -(case - (con integer) - (constr - (sop [(con integer)]) - 0 - (let - (nonrec) - (termbind - (nonstrict) - (vardecl y (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - y - ) - ) - (lam x (con integer) (con integer 1)) -) \ No newline at end of file +case + integer + (constr (sop [integer]) 0 [(let ~y : integer = addInteger 1 2 in y)]) + [(\(x : integer) -> 1)] \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-case-branch.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-case-branch.golden index f5f6a7f6ea8..015c3b9f4f6 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-case-branch.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-case-branch.golden @@ -1,17 +1,4 @@ -(case - (con integer) - (constr (sop [(con integer)]) 0 (con integer 1)) - (lam - x - (con integer) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl y (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - y - ) - ) -) \ No newline at end of file +case + integer + (constr (sop [integer]) 0 [1]) + [(\(x : integer) -> let ~y : integer = addInteger 1 2 in y)] \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-constr.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-constr.golden index 0801f984091..755418bb429 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-constr.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-constr.golden @@ -1,15 +1,4 @@ -(constr - (sop [(con integer) (con integer) (con integer)]) +constr + (sop [integer, integer, integer]) 0 - (con integer 1) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl y (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - y - ) - (con integer 2) -) \ No newline at end of file + [1, (let ~y : integer = addInteger 1 2 in y), 2] \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-fun-and-arg-1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-fun-and-arg-1.golden index cdf029df0ba..8b3bbe1431a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-fun-and-arg-1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-fun-and-arg-1.golden @@ -1,23 +1,10 @@ -[ - [ (builtin addInteger) (con integer 1) ] - [ - (let - (nonrec) - (termbind - (strict) - (vardecl f (fun (con integer) (con integer))) - (lam y (con integer) [ [ (builtin addInteger) y ] (con integer 3) ]) - ) - f - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - x - ) - ] -] \ No newline at end of file +addInteger + 1 + ((let + !f : integer -> integer = \(y : integer) -> addInteger y 3 + in + f) + (let + ~x : integer = addInteger 1 2 + in + x)) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-fun-and-arg-2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-fun-and-arg-2.golden index 61b7fab69ee..10002d591a6 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-fun-and-arg-2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-fun-and-arg-2.golden @@ -1,26 +1,10 @@ -[ - [ - (builtin addInteger) - [ - (let - (nonrec) - (termbind - (strict) - (vardecl f (fun (con integer) (con integer))) - (lam y (con integer) [ [ (builtin addInteger) y ] (con integer 3) ]) - ) - f - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - x - ) - ] - ] - (con integer 1) -] \ No newline at end of file +addInteger + ((let + !f : integer -> integer = \(y : integer) -> addInteger y 3 + in + f) + (let + ~x : integer = addInteger 1 2 + in + x)) + 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-lam1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-lam1.golden index 421def84081..97feb918198 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-lam1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-lam1.golden @@ -1,13 +1,5 @@ -(lam - x - (con integer) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl y (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - [ [ (builtin addInteger) [ [ (builtin addInteger) y ] x ] ] y ] - ) -) \ No newline at end of file +\(x : integer) -> + let + ~y : integer = addInteger 1 2 + in + addInteger (addInteger y x) y \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-lam2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-lam2.golden index 925aba24a0d..16c563ecf5e 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-lam2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-lam2.golden @@ -1,24 +1,5 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl f (fun (con integer) (con integer))) - (lam - y - (con integer) - [ - [ (builtin addInteger) y ] - (let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - x - ) - ] - ) - ) - [ [ (builtin addInteger) [ f (con integer 1) ] ] [ f (con integer 2) ] ] -) \ No newline at end of file +let + !f : integer -> integer + = \(y : integer) -> addInteger y (let ~x : integer = addInteger 1 2 in x) +in +addInteger (f 1) (f 2) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-tyabs1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-tyabs1.golden index cb317973d00..f656a8c0c02 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-tyabs1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-tyabs1.golden @@ -1,40 +1,14 @@ -(abs - a - (type) - (lam - a - a - [ - [ - { - { - (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - Tuple2 - ) - a - } - (con integer) - } - a - ] +/\a -> + \(a : a) -> + (let + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + in + Tuple2) + {a} + {integer} + a (let - (nonrec) - (termbind - (nonstrict) - (vardecl y (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - [ [ (builtin addInteger) y ] y ] - ) - ] - ) -) \ No newline at end of file + ~y : integer = addInteger 1 2 + in + addInteger y y) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-tyabs2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-tyabs2.golden index b0caba0080d..6c8f824f551 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-tyabs2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/float-into-tyabs2.golden @@ -1,21 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl f (all t (type) (con integer))) - (abs - t - (type) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 2) ] - ) - x - ) - ) - ) - [ [ (builtin addInteger) { f (con integer) } ] { f (con integer) } ] -) \ No newline at end of file +let + !f : all t. integer = /\t -> let ~x : integer = addInteger 1 2 in x +in +addInteger (f {integer}) (f {integer}) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/type.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/type.golden index 9844b611adf..7bd281b35de 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/type.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatIn/relaxed/type.golden @@ -1,26 +1,11 @@ -(lam - n - (con integer) - [ +\(n : integer) -> + (let + int = integer + in (let - (nonrec) - (typebind (tyvardecl int (type)) (con integer)) - { - { - (let - (nonrec) - (termbind - (strict) - (vardecl const (all a (type) (all b (type) (fun a (fun b a))))) - (abs a (type) (abs b (type) (lam x a (lam y b x)))) - ) - const - ) - (con integer) - } - int - } - ) - (con integer 1) - ] -) \ No newline at end of file + !const : all a b. a -> b -> a = /\a b -> \(x : a) (y : b) -> x + in + const) + {integer} + {int}) + 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/even3Eval.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/even3Eval.golden index 383d5389454..c56f71eb338 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/even3Eval.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/even3Eval.golden @@ -1,42 +1,20 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl Nat (type)) - - match_Nat - (vardecl Zero Nat) (vardecl Suc (fun Nat Nat)) - ) - ) - (let - (rec) - (termbind - (strict) - (vardecl even (fun Nat Bool)) - (lam n Nat [ [ { [ match_Nat n ] Bool } True ] (lam p Nat [ odd p ]) ]) - ) - (termbind - (strict) - (vardecl odd (fun Nat Bool)) - (lam - n Nat [ [ { [ match_Nat n ] Bool } False ] (lam p Nat [ even p ]) ] - ) - ) - (let - (nonrec) - (termbind (strict) (vardecl three Nat) [ Suc [ Suc [ Suc Zero ] ] ]) - [ even three ] - ) - ) - ) -) \ No newline at end of file +let + data Bool | match_Bool where + True : Bool + False : Bool +in +letrec + data Nat | match_Nat where + Zero : Nat + Suc : Nat -> Nat +in +letrec + !even : Nat -> Bool + = \(n : Nat) -> match_Nat n {Bool} True (\(p : Nat) -> odd p) + !odd : Nat -> Bool + = \(n : Nat) -> match_Nat n {Bool} False (\(p : Nat) -> even p) +in +let + !three : Nat = Suc (Suc (Suc Zero)) +in +even three \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/ifError.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/ifError.golden index 901ad65bba6..24b0ba2f044 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/ifError.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/ifError.golden @@ -1,32 +1,6 @@ -[ - (lam - b - (all a (type) (fun (fun (con integer) a) (fun (fun (con integer) a) a))) - [ - [ - { b (con integer) } - (lam - z - (con integer) - (let - (nonrec) - (termbind - (strict) (vardecl err (con integer)) (error (con integer)) - ) - err - ) - ) - ] - (lam z (con integer) (con integer 1)) - ] - ) - (abs - a - (type) - (lam - x - (fun (con integer) a) - (lam y (fun (con integer) a) [ y (con integer 0) ]) - ) - ) -] \ No newline at end of file +(\(b : all a. (integer -> a) -> (integer -> a) -> a) -> + b + {integer} + (\(z : integer) -> let !err : integer = error {integer} in err) + (\(z : integer) -> 1)) + (/\a -> \(x : integer -> a) (y : integer -> a) -> y 0) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/inLam.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/inLam.golden index 304c202e503..c51c022cfba 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/inLam.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/inLam.golden @@ -1,13 +1 @@ -(lam - x - (con integer) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl y (con integer)) - [ [ (builtin addInteger) (con integer 3) ] x ] - ) - [ [ (builtin addInteger) x ] y ] - ) -) \ No newline at end of file +\(x : integer) -> let ~y : integer = addInteger 3 x in addInteger x y \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/letInLet.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/letInLet.golden index 7cd8e69577f..cd1b8645eb3 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/letInLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/letInLet.golden @@ -1,10 +1,5 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl unitval (all a (type) (fun a a))) - (abs a (type) (lam x a x)) - ) - (termbind (strict) (vardecl unitval2 (all a (type) (fun a a))) unitval) - unitval2 -) \ No newline at end of file +let + !unitval : all a. a -> a = /\a -> \(x : a) -> x + !unitval2 : all a. a -> a = unitval +in +unitval2 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/listMatch.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/listMatch.golden index 4b83ce8f9c8..da736b1dfa0 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/listMatch.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/listMatch.golden @@ -1,39 +1,15 @@ -(lam - x - (con integer) - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - match_List - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl j (con integer)) - [ [ (builtin addInteger) (con integer 3) ] x ] - ) - [ - [ - { - [ - { match_List (all a (type) (fun a a)) } - { Nil (all a (type) (fun a a)) } - ] - (all a (type) (fun a a)) - } - (abs a (type) (lam x a x)) - ] - (lam - h (all a (type) (fun a a)) (lam t [ List (all a (type) (fun a a)) ] h) - ) - ] - ) - ) -) \ No newline at end of file +\(x : integer) -> + letrec + data (List :: * -> *) a | match_List where + Nil : List a + Cons : a -> List a -> List a + in + let + !j : integer = addInteger 3 x + in + match_List + {all a. a -> a} + (Nil {all a. a -> a}) + {all a. a -> a} + (/\a -> \(x : a) -> x) + (\(h : all a. a -> a) (t : List (all a. a -> a)) -> h) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/maybe.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/maybe.golden index 37de78acc03..270a00ce57a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/maybe.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/maybe.golden @@ -1,24 +1,10 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - match_Maybe - (vardecl Nothing [ Maybe a ]) (vardecl Just (fun a [ Maybe a ])) - ) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind - (strict) - (vardecl j (con integer)) - [ [ (builtin addInteger) (con integer 3) ] x ] - ) - [ { Just (all a (type) (fun a a)) } (abs a (type) (lam x a x)) ] - ) - ) -) \ No newline at end of file +let + data (Maybe :: * -> *) a | match_Maybe where + Nothing : Maybe a + Just : a -> Maybe a +in +\(x : integer) -> + let + !j : integer = addInteger 3 x + in + Just {all a. a -> a} (/\a -> \(x : a) -> x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/mutuallyRecursiveTypes.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/mutuallyRecursiveTypes.golden index 40b4312cf50..51ee5546e64 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/mutuallyRecursiveTypes.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/mutuallyRecursiveTypes.golden @@ -1,21 +1,8 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl Tree (fun (type) (type))) - (tyvardecl a (type)) - match_Tree - (vardecl Node (fun a (fun [ Forest a ] [ Tree a ]))) - ) - ) - (datatypebind - (datatype - (tyvardecl Forest (fun (type) (type))) - (tyvardecl a (type)) - match_Forest - (vardecl Nil [ Forest a ]) - (vardecl Cons (fun [ Tree a ] (fun [ Forest a ] [ Forest a ]))) - ) - ) - { Nil (all a (type) (fun a a)) } -) \ No newline at end of file +letrec + data (Tree :: * -> *) a | match_Tree where + Node : a -> Forest a -> Tree a + data (Forest :: * -> *) a | match_Forest where + Nil : Forest a + Cons : Tree a -> Forest a -> Forest a +in +Nil {all a. a -> a} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/mutuallyRecursiveValues.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/mutuallyRecursiveValues.golden index 3e0614c749b..cd10561b364 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/mutuallyRecursiveValues.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/mutuallyRecursiveValues.golden @@ -1,10 +1,5 @@ -(let - (rec) - (termbind (strict) (vardecl x (all a (type) (fun a a))) y) - (termbind - (strict) - (vardecl y (all a (type) (fun a a))) - (abs a (type) (lam z a [ { x a } z ])) - ) - x -) \ No newline at end of file +letrec + !x : all a. a -> a = y + !y : all a. a -> a = /\a -> \(z : a) -> x {a} z +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec1.golden index 544d21ca23a..ed5eb882375 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec1.golden @@ -1,11 +1,6 @@ -(let - (nonrec) - (termbind (strict) (vardecl j (con integer)) (con integer 3)) - (termbind (strict) (vardecl i2 (con integer)) (con integer 3)) - (termbind - (strict) - (vardecl i1 (con integer)) - [ [ (builtin addInteger) i2 ] (con integer 3) ] - ) - [ [ (builtin addInteger) (con integer 5) ] [ [ (builtin addInteger) j ] i2 ] ] -) \ No newline at end of file +let + !j : integer = 3 + !i2 : integer = 3 + !i1 : integer = addInteger i2 3 +in +addInteger 5 (addInteger j i2) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec2.golden index 55a5b79ca3b..7c967ffc0dd 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec2.golden @@ -1,27 +1,11 @@ -(let - (nonrec) - (termbind (strict) (vardecl j1 (con integer)) (con integer 0)) - (termbind (strict) (vardecl j (con integer)) (con integer 0)) - (termbind (strict) (vardecl i2 (con integer)) (con integer 2)) - (lam - x - (con integer) - (let - (nonrec) - (termbind - (strict) - (vardecl i1 (con integer)) - [ [ (builtin addInteger) i2 ] (con integer 1) ] - ) - (termbind - (strict) - (vardecl i (con integer)) - [ - [ (builtin addInteger) i1 ] - [ [ (builtin addInteger) x ] [ [ (builtin addInteger) i2 ] j ] ] - ] - ) - [ [ (builtin addInteger) i ] j1 ] - ) - ) -) \ No newline at end of file +let + !j1 : integer = 0 + !j : integer = 0 + !i2 : integer = 2 +in +\(x : integer) -> + let + !i1 : integer = addInteger i2 1 + !i : integer = addInteger i1 (addInteger x (addInteger i2 j)) + in + addInteger i j1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec3.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec3.golden index 0f85be80534..539c645f163 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec3.golden @@ -1,13 +1 @@ -(lam - x - (con integer) - (let - (nonrec) - (termbind - (strict) - (vardecl i (con integer)) - [ (lam y (con integer) [ [ (builtin addInteger) y ] x ]) (con integer 1) ] - ) - i - ) -) \ No newline at end of file +\(x : integer) -> let !i : integer = (\(y : integer) -> addInteger y x) 1 in i \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec4.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec4.golden index c0cf917e3cd..fb43cded183 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec4.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec4.golden @@ -1,20 +1,4 @@ -(let - (nonrec) - (termbind (strict) (vardecl i (con integer)) (con integer 3)) - [ - (lam - x - (con integer) - (let - (nonrec) - (termbind - (strict) - (vardecl j (con integer)) - [ [ (builtin addInteger) i ] (con integer 1) ] - ) - j - ) - ) - (con integer 4) - ] -) \ No newline at end of file +let + !i : integer = 3 +in +(\(x : integer) -> let !j : integer = addInteger i 1 in j) 4 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec6.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec6.golden index d1f3bc8e794..7ddab8b4799 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec6.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec6.golden @@ -1,21 +1 @@ -(lam - x - (con integer) - (let - (nonrec) - (termbind - (strict) - (vardecl i (con integer)) - (let - (nonrec) - (termbind - (strict) - (vardecl j (con integer)) - [ [ (builtin addInteger) (con integer 1) ] x ] - ) - j - ) - ) - i - ) -) \ No newline at end of file +\(x : integer) -> let !i : integer = let !j : integer = addInteger 1 x in j in i \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec7.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec7.golden index 9b2a77b01f5..104d75e71b3 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec7.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec7.golden @@ -1,24 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl i (con integer)) - [ - (lam - x - (con integer) - (let - (nonrec) - (termbind - (strict) - (vardecl j (con integer)) - [ [ (builtin addInteger) (con integer 1) ] x ] - ) - j - ) - ) - (con integer 1) - ] - ) - i -) \ No newline at end of file +let + !i : integer = (\(x : integer) -> let !j : integer = addInteger 1 x in j) 1 +in +i \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec8.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec8.golden index f8afbc051a1..17eaf3279a3 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec8.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec8.golden @@ -1,28 +1,7 @@ -(let - (nonrec) - (termbind (strict) (vardecl k (con integer)) (con integer 1)) - (termbind - (strict) - (vardecl i (con integer)) - [ - (lam - x - (con integer) - (let - (nonrec) - (termbind - (strict) - (vardecl j (con integer)) - [ - [ (builtin addInteger) k ] - [ [ (builtin addInteger) (con integer 1) ] x ] - ] - ) - j - ) - ) - (con integer 1) - ] - ) - i -) \ No newline at end of file +let + !k : integer = 1 + !i : integer + = (\(x : integer) -> let !j : integer = addInteger k (addInteger 1 x) in j) + 1 +in +i \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec9.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec9.golden index 0ba0042f55d..ac0986e8d75 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec9.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrec9.golden @@ -1,10 +1,5 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl a (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 1) ] - ) - (termbind (nonstrict) (vardecl b (con integer)) a) - b -) \ No newline at end of file +let + !a : integer = addInteger 1 1 + ~b : integer = a +in +b \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrecToNonrec.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrecToNonrec.golden index 09e4f0a1379..12a479d28d1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrecToNonrec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrecToNonrec.golden @@ -1,7 +1,6 @@ -(let - (rec) - (termbind (strict) (vardecl r (con integer)) i) - (termbind (strict) (vardecl j (con integer)) r) - (termbind (strict) (vardecl i (con integer)) j) - (con integer 3) -) \ No newline at end of file +letrec + !r : integer = i + !j : integer = r + !i : integer = j +in +3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrecToRec.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrecToRec.golden index 2f82c7c950a..dbeb4bd8f55 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrecToRec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/nonrecToRec.golden @@ -1,10 +1,5 @@ -(let - (rec) - (termbind (nonstrict) (vardecl r (con integer)) i) - (termbind - (nonstrict) - (vardecl i (con integer)) - (let (nonrec) (termbind (strict) (vardecl j (con integer)) r) j) - ) - (con integer 3) -) \ No newline at end of file +letrec + ~r : integer = i + ~i : integer = let !j : integer = r in j +in +3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/oldFloatBug.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/oldFloatBug.golden index 0ba0042f55d..ac0986e8d75 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/oldFloatBug.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/oldFloatBug.golden @@ -1,10 +1,5 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl a (con integer)) - [ [ (builtin addInteger) (con integer 1) ] (con integer 1) ] - ) - (termbind (nonstrict) (vardecl b (con integer)) a) - b -) \ No newline at end of file +let + !a : integer = addInteger 1 1 + ~b : integer = a +in +b \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/oldLength.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/oldLength.golden index 8aeb454b94f..016d04367b4 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/oldLength.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/oldLength.golden @@ -1,20 +1,5 @@ -(lam - x - (all a (type) (fun a (fun a a))) - (let - (nonrec) - (termbind - (strict) - (vardecl i (con integer)) - [ - (lam - y - (con integer) - (let (nonrec) (termbind (strict) (vardecl j (con integer)) y) y) - ) - (con integer 5) - ] - ) - i - ) -) \ No newline at end of file +\(x : all a. a -> a -> a) -> + let + !i : integer = (\(y : integer) -> let !j : integer = y in y) 5 + in + i \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/outLam.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/outLam.golden index cfefc2dfb9c..9097a34bc23 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/outLam.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/outLam.golden @@ -1,5 +1,4 @@ -(let - (nonrec) - (termbind (nonstrict) (vardecl y (con integer)) (con integer 3)) - (lam x (con integer) [ [ (builtin addInteger) x ] y ]) -) \ No newline at end of file +let + ~y : integer = 3 +in +\(x : integer) -> addInteger x y \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/outRhs.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/outRhs.golden index 7d321cde6cd..81ec31d84e1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/outRhs.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/outRhs.golden @@ -1,14 +1,5 @@ -(let - (rec) - (termbind - (strict) - (vardecl x (con integer)) - (let (nonrec) (termbind (strict) (vardecl y (con integer)) z) y) - ) - (termbind - (nonstrict) - (vardecl z (con integer)) - [ [ (builtin addInteger) x ] (con integer 1) ] - ) - x -) \ No newline at end of file +letrec + !x : integer = let !y : integer = z in y + ~z : integer = addInteger x 1 +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec1.golden index f5ceb8d2628..c6243e1dcef 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec1.golden @@ -1,29 +1,11 @@ -(let - (nonrec) - (termbind (strict) (vardecl i2 (con integer)) (con integer 3)) - (let - (rec) - (termbind - (strict) - (vardecl j (con integer)) - [ [ (builtin addInteger) (con integer 3) ] k ] - ) - (termbind - (strict) - (vardecl k (con integer)) - [ [ (builtin addInteger) (con integer 3) ] j ] - ) - (let - (nonrec) - (termbind - (strict) - (vardecl i1 (con integer)) - [ [ (builtin addInteger) k ] (con integer 3) ] - ) - [ - [ (builtin addInteger) (con integer 5) ] - [ [ (builtin addInteger) j ] i2 ] - ] - ) - ) -) \ No newline at end of file +let + !i2 : integer = 3 +in +letrec + !j : integer = addInteger 3 k + !k : integer = addInteger 3 j +in +let + !i1 : integer = addInteger k 3 +in +addInteger 5 (addInteger j i2) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec2.golden index 84aab17a0d1..f5d89e6963d 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec2.golden @@ -1,41 +1,15 @@ -(let - (nonrec) - (termbind (strict) (vardecl i2 (con integer)) (con integer 3)) - (lam - x - (con integer) - [ - (lam - y - (con integer) - (let - (rec) - (termbind - (strict) (vardecl j (con integer)) [ [ (builtin addInteger) x ] k ] - ) - (termbind - (strict) (vardecl k (con integer)) [ [ (builtin addInteger) y ] j ] - ) - (let - (nonrec) - (termbind - (strict) - (vardecl c (con integer)) - [ [ (builtin addInteger) (con integer 1) ] i2 ] - ) - (termbind - (strict) - (vardecl i1 (con integer)) - [ [ (builtin addInteger) k ] (con integer 3) ] - ) - [ - [ (builtin addInteger) (con integer 5) ] - [ [ (builtin addInteger) j ] i2 ] - ] - ) - ) - ) - (con integer 1) - ] - ) -) \ No newline at end of file +let + !i2 : integer = 3 +in +\(x : integer) -> + (\(y : integer) -> + letrec + !j : integer = addInteger x k + !k : integer = addInteger y j + in + let + !c : integer = addInteger 1 i2 + !i1 : integer = addInteger k 3 + in + addInteger 5 (addInteger j i2)) + 1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec3.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec3.golden index 03b00bbb1be..4b2c020c1e1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec3.golden @@ -1,17 +1,7 @@ -(let - (rec) - (termbind - (strict) - (vardecl j (con integer)) - [ [ (builtin addInteger) (con integer 3) ] j ] - ) - (let - (nonrec) - (termbind - (strict) - (vardecl k (con integer)) - [ [ (builtin addInteger) (con integer 3) ] j ] - ) - [ [ (builtin addInteger) (con integer 5) ] j ] - ) -) \ No newline at end of file +letrec + !j : integer = addInteger 3 j +in +let + !k : integer = addInteger 3 j +in +addInteger 5 j \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec4.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec4.golden index 74e6dcdfbaf..ea942bdc9d8 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec4.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rec4.golden @@ -1,9 +1,4 @@ -(let - (rec) - (termbind - (strict) - (vardecl j (con integer)) - [ [ (builtin addInteger) (con integer 3) ] j ] - ) - (con integer 1) -) \ No newline at end of file +letrec + !j : integer = addInteger 3 j +in +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rhsSqueezeVsNest.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rhsSqueezeVsNest.golden index e5bdee40c82..8356ec82e66 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rhsSqueezeVsNest.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/rhsSqueezeVsNest.golden @@ -1,29 +1,8 @@ -(let - (rec) - (termbind (strict) (vardecl x (con integer)) x') - (termbind (nonstrict) (vardecl x' (con integer)) x) - (let - (rec) - (termbind - (strict) - (vardecl y (con integer)) - [ - (lam - k - (con integer) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl y' (con integer)) - [ [ (builtin addInteger) k ] y ] - ) - y' - ) - ) - y - ] - ) - x - ) -) \ No newline at end of file +letrec + !x : integer = x' + ~x' : integer = x +in +letrec + !y : integer = (\(k : integer) -> let ~y' : integer = addInteger k y in y') y +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue.golden index 2037f1c6a83..2cd190c8795 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue.golden @@ -1,13 +1,4 @@ -(let - (nonrec) - (termbind - (nonstrict) - (vardecl x (con integer)) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) (error (con integer))) - y - ) - ) - (con integer 1) -) \ No newline at end of file +let + ~x : integer = let !y : integer = error {integer} in y +in +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue2.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue2.golden index cd85c70b700..c1fe572e6b5 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue2.golden @@ -1,6 +1,5 @@ -(let - (nonrec) - (termbind (nonstrict) (vardecl y (con integer)) (con integer 1)) - (termbind (strict) (vardecl x (con integer)) [ (lam z (con integer) z) y ]) - (con integer 1) -) \ No newline at end of file +let + ~y : integer = 1 + !x : integer = (\(z : integer) -> z) y +in +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue3.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue3.golden index 07797ca6973..ad2b8466447 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValue3.golden @@ -1,21 +1,5 @@ -(lam - x - (con integer) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl i (con integer)) - (let - (nonrec) - (termbind - (strict) - (vardecl j (con integer)) - [ (lam x (con integer) x) (con integer 1) ] - ) - [ [ (builtin addInteger) j ] x ] - ) - ) - i - ) -) \ No newline at end of file +\(x : integer) -> + let + ~i : integer = let !j : integer = (\(x : integer) -> x) 1 in addInteger j x + in + i \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValueDeep.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValueDeep.golden index b1a1bfeb647..a28736527c9 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValueDeep.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictNonValueDeep.golden @@ -1,18 +1,8 @@ -(let - (rec) - (termbind - (nonstrict) - (vardecl y (con integer)) - [ (lam h (con integer) [ [ (builtin addInteger) z ] h ]) (con integer 4) ] - ) - (termbind (nonstrict) (vardecl z (con integer)) y) - (let - (nonrec) - (termbind - (strict) - (vardecl x (con integer)) - [ (lam k (con integer) [ [ (builtin addInteger) y ] k ]) (con integer 3) ] - ) - x - ) -) \ No newline at end of file +letrec + ~y : integer = (\(h : integer) -> addInteger z h) 4 + ~z : integer = y +in +let + !x : integer = (\(k : integer) -> addInteger y k) 3 +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValue.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValue.golden index 89cd41246e2..c203b7ba6e1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValue.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValue.golden @@ -1,15 +1,4 @@ -(let - (nonrec) - (termbind (strict) (vardecl j (con integer)) (con integer 1)) - (lam - x - (con integer) - (let - (nonrec) - (termbind - (nonstrict) (vardecl i (con integer)) [ [ (builtin addInteger) j ] x ] - ) - i - ) - ) -) \ No newline at end of file +let + !j : integer = 1 +in +\(x : integer) -> let ~i : integer = addInteger j x in i \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValueNonValue.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValueNonValue.golden index 90605db67a9..f693829b273 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValueNonValue.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValueNonValue.golden @@ -1,19 +1,5 @@ -(let - (rec) - (termbind - (strict) - (vardecl value (fun (con integer) (con integer))) - (lam - x - (con integer) - (let - (nonrec) - (termbind - (strict) (vardecl nonvalue (con integer)) [ value (con integer 3) ] - ) - x - ) - ) - ) - (con integer 3) -) \ No newline at end of file +letrec + !value : integer -> integer + = \(x : integer) -> let !nonvalue : integer = value 3 in x +in +3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValueValue.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValueValue.golden index 5f2387f7dff..5ce2c93df6a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValueValue.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/LetFloatOut/strictValueValue.golden @@ -1,14 +1,5 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl value1 (fun (con integer) (con integer))) - (lam x (con integer) x) - ) - (termbind - (strict) - (vardecl value2 (fun (con integer) (con integer))) - (lam y (con integer) [ value1 y ]) - ) - (con integer 3) -) \ No newline at end of file +let + !value1 : integer -> integer = \(x : integer) -> x + !value2 : integer -> integer = \(y : integer) -> value1 y +in +3 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/NonStrict/nonStrict1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/NonStrict/nonStrict1.golden index c3cafa4d29c..670327ef0f4 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/NonStrict/nonStrict1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/NonStrict/nonStrict1.golden @@ -1,9 +1,4 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl unitval (all dead (type) (all a (type) (fun a a)))) - (abs dead (type) (abs a (type) (lam x a x))) - ) - { unitval (all dead (type) dead) } -) \ No newline at end of file +let + !unitval : all dead a. a -> a = /\dead a -> \(x : a) -> x +in +unitval {all dead. dead} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/big.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/big.golden index 568ecdd2eab..c5dab09f854 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/big.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/big.golden @@ -1,48 +1,20 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl Nat (type)) - - match_Nat - (vardecl Zero Nat) (vardecl Suc (fun Nat Nat)) - ) - ) - (let - (rec) - (termbind - (strict) - (vardecl even (fun Nat Bool)) - (lam - n - Nat - [ [ { [ match_Nat n ] Bool } True ] (lam pred Nat [ odd pred ]) ] - ) - ) - (termbind - (strict) - (vardecl odd (fun Nat Bool)) - (lam - n - Nat - [ [ { [ match_Nat n ] Bool } False ] (lam pred Nat [ even pred ]) ] - ) - ) - (let - (nonrec) - (termbind (strict) (vardecl three Nat) [ Suc [ Suc [ Suc Zero ] ] ]) - [ even three ] - ) - ) - ) -) \ No newline at end of file +let + data Bool | match_Bool where + True : Bool + False : Bool +in +letrec + data Nat | match_Nat where + Zero : Nat + Suc : Nat -> Nat +in +letrec + !even : Nat -> Bool + = \(n : Nat) -> match_Nat n {Bool} True (\(pred : Nat) -> odd pred) + !odd : Nat -> Bool + = \(n : Nat) -> match_Nat n {Bool} False (\(pred : Nat) -> even pred) +in +let + !three : Nat = Suc (Suc (Suc Zero)) +in +even three \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/mutuallyRecursiveTypes.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/mutuallyRecursiveTypes.golden index 67d3b17d7b8..a3237d06241 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/mutuallyRecursiveTypes.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/mutuallyRecursiveTypes.golden @@ -1,26 +1,12 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl Tree (fun (type) (type))) - (tyvardecl a (type)) - match_Tree - (vardecl Node (fun a (fun [ Forest a ] [ Tree a ]))) - ) - ) - (datatypebind - (datatype - (tyvardecl Forest (fun (type) (type))) - (tyvardecl a (type)) - match_Forest - (vardecl Nil [ Forest a ]) - (vardecl Cons (fun [ Tree a ] (fun [ Forest a ] [ Forest a ]))) - ) - ) - (let - (rec) - (typebind (tyvardecl unit (type)) unit_) - (typebind (tyvardecl unit_ (type)) unit) - { Nil (all a (type) (fun a a)) } - ) -) \ No newline at end of file +letrec + data (Tree :: * -> *) a | match_Tree where + Node : a -> Forest a -> Tree a + data (Forest :: * -> *) a | match_Forest where + Nil : Forest a + Cons : Tree a -> Forest a -> Forest a +in +letrec + unit = unit_ + unit_ = unit +in +Nil {all a. a -> a} \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/mutuallyRecursiveValues.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/mutuallyRecursiveValues.golden index 3e0614c749b..cd10561b364 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/mutuallyRecursiveValues.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/mutuallyRecursiveValues.golden @@ -1,10 +1,5 @@ -(let - (rec) - (termbind (strict) (vardecl x (all a (type) (fun a a))) y) - (termbind - (strict) - (vardecl y (all a (type) (fun a a))) - (abs a (type) (lam z a [ { x a } z ])) - ) - x -) \ No newline at end of file +letrec + !x : all a. a -> a = y + !y : all a. a -> a = /\a -> \(z : a) -> x {a} z +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/selfrecursive.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/selfrecursive.golden index 2f0fe764e4b..7627721b07d 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/selfrecursive.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/selfrecursive.golden @@ -1,24 +1,12 @@ -(let - (rec) - (typebind (tyvardecl unit (type)) (all a (type) (fun unit unit))) - (let - (rec) - (datatypebind - (datatype - (tyvardecl Nat (type)) - - match_Nat - (vardecl Zero Nat) (vardecl Suc (fun Nat Nat)) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl r (con integer)) - [ [ (builtin addInteger) r ] (con integer 3) ] - ) - r - ) - ) -) \ No newline at end of file +letrec + unit = all a. unit -> unit +in +letrec + data Nat | match_Nat where + Zero : Nat + Suc : Nat -> Nat +in +letrec + ~r : integer = addInteger r 3 +in +r \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/small.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/small.golden index 75b4f5911b1..306857bb5e2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/small.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/small.golden @@ -1,16 +1,12 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (let - (nonrec) - (termbind (strict) (vardecl false Bool) False) - (let (nonrec) (termbind (strict) (vardecl anotherFalse Bool) false) false) - ) -) \ No newline at end of file +let + data Bool | match_Bool where + True : Bool + False : Bool +in +let + !false : Bool = False +in +let + !anotherFalse : Bool = false +in +false \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/truenonrec.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/truenonrec.golden index ed8d108f66e..835e78d3ea0 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/truenonrec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RecSplit/truenonrec.golden @@ -1,20 +1,15 @@ -(let - (nonrec) - (typebind (tyvardecl unit (type)) (all a (type) (fun a a))) - (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - match_Bool - (vardecl True Bool) (vardecl False Bool) - ) - ) - (let - (nonrec) - (termbind (strict) (vardecl true Bool) True) - (let (nonrec) (termbind (strict) (vardecl false Bool) False) false) - ) - ) -) \ No newline at end of file +let + unit = all a. a -> a +in +let + data Bool | match_Bool where + True : Bool + False : Bool +in +let + !true : Bool = True +in +let + !false : Bool = False +in +false \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/allShadowedDataNonRec.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/allShadowedDataNonRec.golden index ba417512f99..c9d504929dd 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/allShadowedDataNonRec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/allShadowedDataNonRec.golden @@ -1,12 +1,5 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl D_5 (type)) - - match_D_7 - (vardecl C_6 (all D_8 (type) (fun D_8 D_5))) - ) - ) - (abs a_9 (type) (lam x_10 a_9 x_10)) -) \ No newline at end of file +let + data D | match_D where + C : all D. D -> D +in +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/allShadowedDataRec.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/allShadowedDataRec.golden index 7371cf08d6a..ed7ff399a8b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/allShadowedDataRec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/allShadowedDataRec.golden @@ -1,12 +1,5 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl D_5 (type)) - - match_D_7 - (vardecl C_6 (all D_8 (type) (fun D_8 D_5))) - ) - ) - (abs a_9 (type) (lam x_10 a_9 x_10)) -) \ No newline at end of file +letrec + data D | match_D where + C : all D. D -> D +in +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/paramShadowedDataNonRec.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/paramShadowedDataNonRec.golden index 7a4cba7bcb8..7ee39f709ec 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/paramShadowedDataNonRec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/paramShadowedDataNonRec.golden @@ -1,12 +1,5 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl D_5 (fun (type) (type))) - (tyvardecl D_8 (type)) - match_D_7 - (vardecl C_6 [ D_5 D_8 ]) - ) - ) - (abs a_9 (type) (lam x_10 a_9 x_10)) -) \ No newline at end of file +let + data (D :: * -> *) D | match_D where + C : D D +in +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/paramShadowedDataRec.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/paramShadowedDataRec.golden index 89a7f4874f4..4c7954f07c4 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/paramShadowedDataRec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Rename/paramShadowedDataRec.golden @@ -1,12 +1,5 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl D_5 (fun (type) (type))) - (tyvardecl D_8 (type)) - match_D_7 - (vardecl C_6 [ D_5 D_8 ]) - ) - ) - (abs a_9 (type) (lam x_10 a_9 x_10)) -) \ No newline at end of file +letrec + data (D :: * -> *) D | match_D where + C : D D +in +/\a -> \(x : a) -> x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/divideInt.pir.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/divideInt.pir.golden index ce5d787e5e6..770ef03caeb 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/divideInt.pir.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/divideInt.pir.golden @@ -1,7 +1 @@ -[ - [ - (builtin divideInteger) - [ [ (builtin addInteger) (con integer 10) ] (con integer 2) ] - ] - (con integer 5) -] \ No newline at end of file +divideInteger (addInteger 10 2) 5 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/equalsInt.pir.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/equalsInt.pir.golden index 87dbfd22e67..4913562233b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/equalsInt.pir.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/equalsInt.pir.golden @@ -1,4 +1 @@ -[ - [ (builtin equalsInteger) (con integer 5) ] - [ [ (builtin addInteger) (con integer 10) ] (con integer 2) ] -] \ No newline at end of file +equalsInteger 5 (addInteger 10 2) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/let.pir.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/let.pir.golden index b5baf093451..8e874665ac2 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/let.pir.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/let.pir.golden @@ -1,8 +1,4 @@ -(let - (nonrec) - (termbind (strict) (vardecl x (con integer)) (error (con integer))) - [ - [ (builtin equalsInteger) (con integer 5) ] - [ [ (builtin addInteger) (con integer 10) ] x ] - ] -) \ No newline at end of file +let + !x : integer = error {integer} +in +equalsInteger 5 (addInteger 10 x) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/multiplyInt.pir.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/multiplyInt.pir.golden index f28c8c1fe87..ce059876100 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/multiplyInt.pir.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/multiplyInt.pir.golden @@ -1,4 +1 @@ -[ - [ (builtin multiplyInteger) (con integer 5) ] - [ [ (builtin addInteger) (con integer 10) ] (con integer 2) ] -] \ No newline at end of file +multiplyInteger 5 (addInteger 10 2) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/unConstrConstrDataFst.pir.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/unConstrConstrDataFst.pir.golden index 7dad83c70a4..f1b6c7741b4 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/unConstrConstrDataFst.pir.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/unConstrConstrDataFst.pir.golden @@ -1,41 +1,13 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyD_1099 (type)) - - MyD_match_1102 - (vardecl MyD_1100 (fun (con integer) MyD_1099)) - (vardecl MyD_1101 (fun (con bytestring) MyD_1099)) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl generated (con integer)) - [ - [ { (builtin trace) (con integer) } (con string "BEFORE") ] - (con integer 0) - ] - ) - (let - (nonrec) - (termbind - (strict) - (vardecl generated [ (con list) (con data) ]) - [ - [ { (builtin trace) [ (con list) (con data) ] } (con string "AFTER") ] - [ - [ - { (builtin mkCons) (con data) } - [ (builtin iData) (con integer 1) ] - ] - [ (builtin mkNilData) (con unit ()) ] - ] - ] - ) - generated - ) - ) -) \ No newline at end of file +let + data MyD_1099 | MyD_match_1102 where + MyD_1100 : integer -> MyD_1099 + MyD_1101 : bytestring -> MyD_1099 +in +let + !generated : integer = trace {integer} "BEFORE" 0 +in +let + !generated : list data + = trace {list data} "AFTER" (mkCons {data} (iData 1) (mkNilData ())) +in +generated \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/unConstrConstrDataSnd.pir.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/unConstrConstrDataSnd.pir.golden index a9d8728185b..d3b9d7e9dde 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/unConstrConstrDataSnd.pir.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/RewriteRules/unConstrConstrDataSnd.pir.golden @@ -1,16 +1,6 @@ -(let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyD_1099 (type)) - - MyD_match_1102 - (vardecl MyD_1100 (fun (con integer) MyD_1099)) - (vardecl MyD_1101 (fun (con bytestring) MyD_1099)) - ) - ) - [ - [ { (builtin mkCons) (con data) } [ (builtin iData) (con integer 1) ] ] - [ (builtin mkNilData) (con unit ()) ] - ] -) \ No newline at end of file +let + data MyD_1099 | MyD_match_1102 where + MyD_1100 : integer -> MyD_1099 + MyD_1101 : bytestring -> MyD_1099 +in +mkCons {data} (iData 1) (mkNilData ()) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/conapp.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/conapp.golden index 4723d56e64a..b51d6fd98e6 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/conapp.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/conapp.golden @@ -1,21 +1,9 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - match_List - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl x [ List (con integer) ]) - [ [ { Cons (con integer) } (con integer 1) ] { Nil (con integer) } ] - ) - x - ) -) \ No newline at end of file +letrec + data (List :: * -> *) a | match_List where + Nil : List a + Cons : a -> List a -> List a +in +let + !x : List integer = Cons {integer} 1 (Nil {integer}) +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/impure1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/impure1.golden index cecea5f7ea8..f478f4c2641 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/impure1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/impure1.golden @@ -1,10 +1,5 @@ -(let - (nonrec) - (termbind - (strict) - (vardecl inc (fun (con integer) (con integer))) - (lam x (con integer) [ [ (builtin addInteger) x ] (con integer 1) ]) - ) - (termbind (nonstrict) (vardecl x (con integer)) [ inc (con integer 1) ]) - x -) \ No newline at end of file +let + !inc : integer -> integer = \(x : integer) -> addInteger x 1 + ~x : integer = inc 1 +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/pure1.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/pure1.golden index 6eadfc97a93..4a00f3bab86 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/pure1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/pure1.golden @@ -1 +1,4 @@ -(let (nonrec) (termbind (strict) (vardecl x (con integer)) (con integer 1)) x) \ No newline at end of file +let + !x : integer = 1 +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/unused.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/unused.golden index f997c97a207..f19ce44bc78 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/unused.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/StrictifyBindings/unused.golden @@ -1,5 +1,4 @@ -(let - (nonrec) - (termbind (strict) (vardecl x (con integer)) (con integer 1)) - (con integer 1) -) \ No newline at end of file +let + !x : integer = 1 +in +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/errorBinding.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/errorBinding.golden index a2b6eb67265..0347fdd9dcd 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/errorBinding.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/errorBinding.golden @@ -1,6 +1,8 @@ -(let - (rec) - (termbind (nonstrict) (vardecl x (con integer)) (error (con integer))) - (termbind (nonstrict) (vardecl y (con integer)) x) - (let (nonrec) (termbind (strict) (vardecl x (con integer)) x) (con integer 1)) -) \ No newline at end of file +letrec + ~x : integer = error {integer} + ~y : integer = x +in +let + !x : integer = x +in +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/listFold.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/listFold.golden index 5490f98189c..98506bb8c29 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/listFold.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/listFold.golden @@ -1,74 +1,20 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - match_List - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl - foldl - (all - a - (type) - (all b (type) (fun (fun b (fun a b)) (fun b (fun [ List a ] b)))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun b (fun a b)) - (lam - acc - b - (lam - lst - [ List a ] - [ - [ { [ { match_List a } lst ] b } acc ] - (lam - x - a - (lam - xs - [ List a ] - [ [ [ { { foldl a } b } f ] [ [ f acc ] x ] ] xs ] - ) - ) - ] - ) - ) - ) - ) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl - foldl - (all - a - (type) - (all b (type) (fun (fun b (fun a b)) (fun b (fun [ List a ] b)))) - ) - ) - foldl - ) - foldl - ) - ) -) \ No newline at end of file +letrec + data (List :: * -> *) a | match_List where + Nil : List a + Cons : a -> List a -> List a +in +letrec + ~foldl : all a b. (b -> a -> b) -> b -> List a -> b + = /\a b -> + \(f : b -> a -> b) (acc : b) (lst : List a) -> + match_List + {a} + lst + {b} + acc + (\(x : a) (xs : List a) -> foldl {a} {b} f (f acc x) xs) +in +let + !foldl : all a b. (b -> a -> b) -> b -> List a -> b = foldl +in +foldl \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/listFoldTrace.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/listFoldTrace.golden index 756d649f18e..5a3f9d1e67b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/listFoldTrace.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/listFoldTrace.golden @@ -1,77 +1,21 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - match_List - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl - foldl - (all - a - (type) - (all b (type) (fun (fun b (fun a b)) (fun b (fun [ List a ] b)))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun b (fun a b)) - (lam - acc - b - (lam - lst - [ List a ] - [ - [ { [ { match_List a } lst ] b } acc ] - (lam - x - a - (lam - xs - [ List a ] - [ - [ { (builtin trace) b } (con string "hello") ] - [ [ [ { { foldl a } b } f ] [ [ f acc ] x ] ] xs ] - ] - ) - ) - ] - ) - ) - ) - ) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl - foldl - (all - a - (type) - (all b (type) (fun (fun b (fun a b)) (fun b (fun [ List a ] b)))) - ) - ) - foldl - ) - foldl - ) - ) -) \ No newline at end of file +letrec + data (List :: * -> *) a | match_List where + Nil : List a + Cons : a -> List a -> List a +in +letrec + ~foldl : all a b. (b -> a -> b) -> b -> List a -> b + = /\a b -> + \(f : b -> a -> b) (acc : b) (lst : List a) -> + match_List + {a} + lst + {b} + acc + (\(x : a) (xs : List a) -> + trace {b} "hello" (foldl {a} {b} f (f acc x) xs)) +in +let + !foldl : all a b. (b -> a -> b) -> b -> List a -> b = foldl +in +foldl \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/monoMap.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/monoMap.golden index 56054fc3165..b6577226807 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/monoMap.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/monoMap.golden @@ -1,49 +1,17 @@ -(let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - match_List - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (rec) - (termbind - (strict) - (vardecl - map - (fun - (fun (con integer) (con integer)) - (fun [ List (con integer) ] [ List (con integer) ]) - ) - ) - (lam - f - (fun (con integer) (con integer)) - (lam +letrec + data (List :: * -> *) a | match_List where + Nil : List a + Cons : a -> List a -> List a +in +letrec + !map : (integer -> integer) -> List integer -> List integer + = \(f : integer -> integer) (lst : List integer) -> + match_List + {integer} lst - [ List (con integer) ] - [ - [ - { [ { match_List (con integer) } lst ] [ List (con integer) ] } - { Nil (con integer) } - ] - (lam - x - (con integer) - (lam - xs - [ List (con integer) ] - [ [ { Cons (con integer) } [ f x ] ] [ [ map f ] xs ] ] - ) - ) - ] - ) - ) - ) - map - ) -) \ No newline at end of file + {List integer} + (Nil {integer}) + (\(x : integer) (xs : List integer) -> + Cons {integer} (f x) (map f xs)) +in +map \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/mutuallyRecursiveValues.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/mutuallyRecursiveValues.golden index 2fdd30b32d8..e6ba9004cd5 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/mutuallyRecursiveValues.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/mutuallyRecursiveValues.golden @@ -1,15 +1,9 @@ -(let - (rec) - (termbind (nonstrict) (vardecl x (all a (type) (fun a a))) y) - (termbind - (nonstrict) - (vardecl y (all a (type) (fun a a))) - (abs a (type) (lam z a [ { x a } z ])) - ) - (let - (nonrec) - (termbind (strict) (vardecl x (all a (type) (fun a a))) x) - (termbind (strict) (vardecl y (all a (type) (fun a a))) y) - x - ) -) \ No newline at end of file +letrec + ~x : all a. a -> a = y + ~y : all a. a -> a = /\a -> \(z : a) -> x {a} z +in +let + !x : all a. a -> a = x + !y : all a. a -> a = y +in +x \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/preserveEffectOrder.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/preserveEffectOrder.golden index c36ab2625c4..23dfff6a4b0 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/preserveEffectOrder.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/preserveEffectOrder.golden @@ -1,21 +1,10 @@ -(let - (rec) - (termbind (nonstrict) (vardecl x (con integer)) (error (con integer))) - (termbind - (nonstrict) - (vardecl y (fun (con integer) (con integer))) - [ - [ - { (builtin trace) (fun (con integer) (con integer)) } - (con string "SHOULD NOT BE PRINTED") - ] - (lam z (con integer) z) - ] - ) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (termbind (strict) (vardecl y (fun (con integer) (con integer))) y) - (con integer 1) - ) -) \ No newline at end of file +letrec + ~x : integer = error {integer} + ~y : integer -> integer + = trace {integer -> integer} "SHOULD NOT BE PRINTED" (\(z : integer) -> z) +in +let + !x : integer = x + !y : integer -> integer = y +in +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/preserveStrictness.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/preserveStrictness.golden index 51c7a166f3e..0c09610fd34 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/preserveStrictness.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/ThunkRecursions/preserveStrictness.golden @@ -1,11 +1,9 @@ -(let - (rec) - (termbind (nonstrict) (vardecl x (con integer)) (con integer 1)) - (termbind (nonstrict) (vardecl y (con integer)) (con integer 2)) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (termbind (strict) (vardecl y (con integer)) y) - (con integer 1) - ) -) \ No newline at end of file +letrec + ~x : integer = 1 + ~y : integer = 2 +in +let + !x : integer = x + !y : integer = y +in +1 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/Transform/Unwrap/unwrapWrap.golden b/plutus-core/plutus-ir/test/PlutusIR/Transform/Unwrap/unwrapWrap.golden index 24aebcf99ce..efac3fa3ca1 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/Transform/Unwrap/unwrapWrap.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/Transform/Unwrap/unwrapWrap.golden @@ -1,34 +1,7 @@ -(abs - a - (type) - (abs - r - (type) - (lam - z - r - (lam - f - (fun - a - (fun - (ifix - (lam - list - (fun (type) (type)) - (lam - a - (type) - (all r (type) (fun r (fun (fun a (fun [ list a ] r)) r))) - ) - ) - a - ) - r - ) - ) - z - ) - ) - ) -) \ No newline at end of file +/\a r -> + \(z : r) + (f : + a -> + ifix (\(list :: * -> *) a -> all r. r -> (a -> list a -> r) -> r) a -> + r) -> + z \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/even3Eval.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/even3Eval.golden index e522d1df3ba..7decd544a4e 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/even3Eval.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/even3Eval.golden @@ -1 +1 @@ -Bool_17 \ No newline at end of file +Bool-17 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/ifError.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/ifError.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/ifError.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/ifError.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/letInLet.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/letInLet.golden index 6eca618c961..4941d69ff8b 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/letInLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/letInLet.golden @@ -1 +1 @@ -(all a_11 (type) (fun a_11 a_11)) \ No newline at end of file +all a-11. a-11 -> a-11 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/listMatch.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/listMatch.golden index 5ce0a6292ed..4ea3c545cff 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/listMatch.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/listMatch.golden @@ -1 +1 @@ -(fun (con integer) (all a_42 (type) (fun a_42 a_42))) \ No newline at end of file +integer -> (all a-42. a-42 -> a-42) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/maybe.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/maybe.golden index c8d808d2857..fdb721b5c2e 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/maybe.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/maybe.golden @@ -1 +1 @@ -(fun (con integer) [ Maybe_9 (all a_25 (type) (fun a_25 a_25)) ]) \ No newline at end of file +integer -> Maybe-9 (all a-25. a-25 -> a-25) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/mutuallyRecursiveTypes.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/mutuallyRecursiveTypes.golden index 9f5a9c503b2..4356d89a614 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/mutuallyRecursiveTypes.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/mutuallyRecursiveTypes.golden @@ -1 +1 @@ -[ Forest_11 (all a_34 (type) (fun a_34 a_34)) ] \ No newline at end of file +Forest-11 (all a-34. a-34 -> a-34) \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/mutuallyRecursiveValues.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/mutuallyRecursiveValues.golden index c0626874c74..40826269b6a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/mutuallyRecursiveValues.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/mutuallyRecursiveValues.golden @@ -1 +1 @@ -(all a_12 (type) (fun a_12 a_12)) \ No newline at end of file +all a-12. a-12 -> a-12 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonSelfRecursive.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonSelfRecursive.golden index 40e6cd03780..f26dde336d5 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonSelfRecursive.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonSelfRecursive.golden @@ -1,2 +1,2 @@ Error during PIR typechecking: -Free type variable at nonSelfRecursive:8:57-8:60 : List \ No newline at end of file +Free type variable at nonSelfRecursive:8:57-8:60 : List-0 \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec1.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec1.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec1.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec2.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec2.golden index 63842ebe8d4..c16d3c3ff73 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec2.golden @@ -1 +1 @@ -(fun (con integer) (con integer)) \ No newline at end of file +integer -> integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec3.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec3.golden index 63842ebe8d4..c16d3c3ff73 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec3.golden @@ -1 +1 @@ -(fun (con integer) (con integer)) \ No newline at end of file +integer -> integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec4.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec4.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec4.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec4.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec6.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec6.golden index 63842ebe8d4..c16d3c3ff73 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec6.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec6.golden @@ -1 +1 @@ -(fun (con integer) (con integer)) \ No newline at end of file +integer -> integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec7.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec7.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec7.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec7.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec8.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec8.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec8.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrec8.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrecToNonrec.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrecToNonrec.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrecToNonrec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrecToNonrec.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrecToRec.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrecToRec.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrecToRec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/nonrecToRec.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/oldLength.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/oldLength.golden index f66430cf089..24ce391cbfb 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/oldLength.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/oldLength.golden @@ -1 +1 @@ -(fun (all a_6 (type) (fun a_6 (fun a_6 a_6))) (con integer)) \ No newline at end of file +(all a-6. a-6 -> a-6 -> a-6) -> integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec1.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec1.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec1.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec1.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec2.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec2.golden index 63842ebe8d4..c16d3c3ff73 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec2.golden @@ -1 +1 @@ -(fun (con integer) (con integer)) \ No newline at end of file +integer -> integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec3.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec3.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec3.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec4.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec4.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec4.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/rec4.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/sameNameDifferentEnv.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/sameNameDifferentEnv.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/sameNameDifferentEnv.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/sameNameDifferentEnv.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue2.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue2.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue2.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue2.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue3.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue3.golden index 63842ebe8d4..c16d3c3ff73 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue3.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValue3.golden @@ -1 +1 @@ -(fun (con integer) (con integer)) \ No newline at end of file +integer -> integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValueDeep.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValueDeep.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValueDeep.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictNonValueDeep.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValue.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValue.golden index 63842ebe8d4..c16d3c3ff73 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValue.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValue.golden @@ -1 +1 @@ -(fun (con integer) (con integer)) \ No newline at end of file +integer -> integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValueNonValue.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValueNonValue.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValueNonValue.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValueNonValue.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValueValue.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValueValue.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValueValue.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/strictValueValue.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLet.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLet.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLet.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLet.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLetRec.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLetRec.golden index a1674e0be4b..c0740e5a58a 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLetRec.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLetRec.golden @@ -1 +1 @@ -(con integer) \ No newline at end of file +integer \ No newline at end of file diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLetWrong.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLetWrong.golden index 415f269ca8d..0cf12927b2c 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLetWrong.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/typeLetWrong.golden @@ -1,7 +1,7 @@ Error during PIR typechecking: Type mismatch at typeLetWrong:4:3-4:33 Expected a term of type - 'a' + 'a-2' But found one of type '(con integer)' Namely, diff --git a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/wrongDataConstrReturnType.golden b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/wrongDataConstrReturnType.golden index 7efa510bbb8..c03bfdbbf82 100644 --- a/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/wrongDataConstrReturnType.golden +++ b/plutus-core/plutus-ir/test/PlutusIR/TypeCheck/wrongDataConstrReturnType.golden @@ -1,3 +1,3 @@ Error during PIR typechecking: The result-type of a dataconstructor is malformed at location wrongDataConstrReturnType:4:5-10:5 -The expected result-type is: [ Maybe a ] \ No newline at end of file +The expected result-type is: [ Maybe-5 a-9 ] \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Analysis/evalOrder/letFun.golden b/plutus-core/untyped-plutus-core/test/Analysis/evalOrder/letFun.golden index d67be8cc736..8701a7d17ce 100644 --- a/plutus-core/untyped-plutus-core/test/Analysis/evalOrder/letFun.golden +++ b/plutus-core/untyped-plutus-core/test/Analysis/evalOrder/letFun.golden @@ -1,7 +1,7 @@ -pure work-free: (\n -> n 1 1) -pure work-free: (addInteger) -pure maybe work?: ((\n -> n 1 1) addInteger) -pure work-free: n +pure work-free: \n-0 -> n-0 1 1 +pure work-free: addInteger +pure maybe work?: (\n-0 -> n-0 1 1) addInteger +pure work-free: n-0 pure work-free: 1 -pure maybe work?: (n 1) +pure maybe work?: n-0 1 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Analysis/evalOrder/letImpure.golden b/plutus-core/untyped-plutus-core/test/Analysis/evalOrder/letImpure.golden index 549116771e4..799dbf110ef 100644 --- a/plutus-core/untyped-plutus-core/test/Analysis/evalOrder/letImpure.golden +++ b/plutus-core/untyped-plutus-core/test/Analysis/evalOrder/letImpure.golden @@ -1,5 +1,5 @@ -pure work-free: (\n -> n 1 1) -pure work-free: m +pure work-free: \n-0 -> n-0 1 1 +pure work-free: m-1 pure work-free: 1 -pure maybe work?: (m 1) +pure maybe work?: m-1 1 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okConst.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okConst.uplc.golden index f5999fde189..b1099958fe3 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okConst.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okConst.uplc.golden @@ -1,3 +1 @@ -(Right (program - 1.1.0 [ [ (lam i_0 (lam i_1 i_0)) (con bool True) ] (lam i_2 i_2) ] -)) \ No newline at end of file +(Right (program 1.1.0 [ [ (lam i (lam i i)) (con bool True) ] (lam i i) ])) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okDeep0.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okDeep0.uplc.golden index 0167e3691d4..142ed893d7d 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okDeep0.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okDeep0.uplc.golden @@ -1,15 +1,6 @@ (Right (program 1.1.0 (lam - i_0 - (lam - i_1 - (lam - i_2 - (lam - i_3 (lam i_4 (lam i_5 (lam i_6 (lam i_7 (lam i_8 (lam i_9 i_0)))))) - ) - ) - ) + i (lam i (lam i (lam i (lam i (lam i (lam i (lam i (lam i (lam i i))))))))) ) )) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okDeep99.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okDeep99.uplc.golden index 0167e3691d4..142ed893d7d 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okDeep99.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okDeep99.uplc.golden @@ -1,15 +1,6 @@ (Right (program 1.1.0 (lam - i_0 - (lam - i_1 - (lam - i_2 - (lam - i_3 (lam i_4 (lam i_5 (lam i_6 (lam i_7 (lam i_8 (lam i_9 i_0)))))) - ) - ) - ) + i (lam i (lam i (lam i (lam i (lam i (lam i (lam i (lam i (lam i i))))))))) ) )) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okId0.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okId0.uplc.golden index a7f77a006c8..0665c3a3849 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okId0.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okId0.uplc.golden @@ -1 +1 @@ -(Right (program 1.1.0 (lam i_0 i_0))) \ No newline at end of file +(Right (program 1.1.0 (lam i i))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okId99.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okId99.uplc.golden index a7f77a006c8..0665c3a3849 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okId99.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okId99.uplc.golden @@ -1 +1 @@ -(Right (program 1.1.0 (lam i_0 i_0))) \ No newline at end of file +(Right (program 1.1.0 (lam i i))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okMix1.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okMix1.uplc.golden index 8c00e7c4b70..5d0a43381ff 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okMix1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okMix1.uplc.golden @@ -1,42 +1,34 @@ (Right (program 1.1.0 (lam - i_0 + i (lam - i_1 + i (lam - i_2 + i (lam - i_3 + i (lam - i_4 + i (lam - i_5 + i (lam - i_6 + i (lam - i_7 + i (lam - i_8 + i (lam - i_9 + i (lam - i_10 + i (lam - i_11 + i (lam - i_12 + i (lam - i_13 - (lam - i_14 - (lam - i_15 - (lam - i_16 (lam i_17 (lam i_18 (lam i_19 i_0))) - ) - ) - ) + i + (lam i (lam i (lam i (lam i (lam i (lam i i)))))) ) ) ) diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okMix2.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okMix2.uplc.golden index 8c00e7c4b70..5d0a43381ff 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okMix2.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Default/okMix2.uplc.golden @@ -1,42 +1,34 @@ (Right (program 1.1.0 (lam - i_0 + i (lam - i_1 + i (lam - i_2 + i (lam - i_3 + i (lam - i_4 + i (lam - i_5 + i (lam - i_6 + i (lam - i_7 + i (lam - i_8 + i (lam - i_9 + i (lam - i_10 + i (lam - i_11 + i (lam - i_12 + i (lam - i_13 - (lam - i_14 - (lam - i_15 - (lam - i_16 (lam i_17 (lam i_18 (lam i_19 i_0))) - ) - ) - ) + i + (lam i (lam i (lam i (lam i (lam i (lam i i)))))) ) ) ) diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceConst.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceConst.uplc.golden index f862ebf0901..b1099958fe3 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceConst.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceConst.uplc.golden @@ -1,3 +1 @@ -(Right (program - 1.1.0 [ [ (lam i_0 (lam i_1 i_0)) (con bool True) ] (lam i_2 i_3) ] -)) \ No newline at end of file +(Right (program 1.1.0 [ [ (lam i (lam i i)) (con bool True) ] (lam i i) ])) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceDeep.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceDeep.uplc.golden index 66d0e7761ba..d0dadd981fb 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceDeep.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceDeep.uplc.golden @@ -1 +1 @@ -(Right (program 1.1.0 (lam i_0 (lam i_1 (lam i_2 (lam i_3 (lam i_4 i_5))))))) \ No newline at end of file +(Right (program 1.1.0 (lam i (lam i (lam i (lam i (lam i i))))))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceElaborate.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceElaborate.uplc.golden index ddf25db5e64..d99651f8f8b 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceElaborate.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceElaborate.uplc.golden @@ -1,3 +1 @@ -(Right (program - 1.1.0 (lam i_0 [ [ [ i_1 i_0 ] i_2 ] (lam i_3 [ [ [ i_3 i_4 ] i_1 ] i_2 ]) ]) -)) \ No newline at end of file +(Right (program 1.1.0 (lam i [ [ [ i i ] i ] (lam i [ [ [ i i ] i ] i ]) ]))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceTop.uplc.golden b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceTop.uplc.golden index eba26a51d89..da087a892a0 100644 --- a/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceTop.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/DeBruijn/Golden/Graceful/graceTop.uplc.golden @@ -1 +1 @@ -(Right (program 1.1.0 (delay i_0))) \ No newline at end of file +(Right (program 1.1.0 (delay i))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/List/headList-empty.err.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/List/headList-empty.err.golden index 0f8c3121e2d..637f25975e2 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/List/headList-empty.err.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/List/headList-empty.err.golden @@ -1,5 +1,5 @@ An error has occurred: The machine terminated because of an error, either from a built-in function or from an explicit use of 'error'. -Caused by: (force headList []) +Caused by: force headList [] Logs were: Expected a non-empty list but got an empty one \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/List/tailList-empty.err.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/List/tailList-empty.err.golden index 7d9ddbf5dc9..ee22967c0ab 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/List/tailList-empty.err.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/List/tailList-empty.err.golden @@ -1,5 +1,5 @@ An error has occurred: The machine terminated because of an error, either from a built-in function or from an explicit use of 'error'. -Caused by: (force tailList []) +Caused by: force tailList [] Logs were: Expected a non-empty list but got an empty one \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/consByteString-out-of-range.err.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/consByteString-out-of-range.err.golden index 5100ab0a4a7..af98afba61d 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/consByteString-out-of-range.err.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/consByteString-out-of-range.err.golden @@ -1,5 +1,5 @@ An error has occurred: The machine terminated because of an error, either from a built-in function or from an explicit use of 'error'. -Caused by: (consByteString 256 #68656c6c6f20776f726c64) +Caused by: consByteString 256 #68656c6c6f20776f726c64 Logs were: 256 is not within the bounds of Word8 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/indexByteString-out-of-bounds-empty.err.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/indexByteString-out-of-bounds-empty.err.golden index 7bc851206a0..1c9b2c9bf7e 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/indexByteString-out-of-bounds-empty.err.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/indexByteString-out-of-bounds-empty.err.golden @@ -1,5 +1,5 @@ An error has occurred: The machine terminated because of an error, either from a built-in function or from an explicit use of 'error'. -Caused by: (indexByteString # 0) +Caused by: indexByteString # 0 Logs were: Index out of bounds \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/indexByteString-out-of-bounds-non-empty.err.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/indexByteString-out-of-bounds-non-empty.err.golden index 0347aa759b2..6cc669165e0 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/indexByteString-out-of-bounds-non-empty.err.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Golden/String/indexByteString-out-of-bounds-non-empty.err.golden @@ -1,5 +1,5 @@ An error has occurred: The machine terminated because of an error, either from a built-in function or from an explicit use of 'error'. -Caused by: (indexByteString #68656c6c6f20776f726c64 12) +Caused by: indexByteString #68656c6c6f20776f726c64 12 Logs were: Index out of bounds \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/closure.plc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/closure.plc.golden index 9d17ef9a5a4..9a0fbbf5ad2 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/closure.plc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/closure.plc.golden @@ -1 +1 @@ -(Right (lam j_1 (con integer 1))) \ No newline at end of file +(Right (lam j (con integer 1))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/closure.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/closure.uplc.golden index c37c65ee4b3..9a0fbbf5ad2 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/closure.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/closure.uplc.golden @@ -1 +1 @@ -(Right (lam j_0 (con integer 1))) \ No newline at end of file +(Right (lam j (con integer 1))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/ite.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/ite.type.golden index 4a34bc25070..69bf353e2df 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/ite.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/ite.type.golden @@ -1 +1 @@ -(Right (all a_2 (type) (fun (con bool) (fun a_2 (fun a_2 a_2))))) \ No newline at end of file +(Right (all a (type) (fun (con bool) (fun a (fun a a))))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKind.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKind.type.golden index 6634145229d..cbc76b82358 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKind.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKind.type.golden @@ -4,4 +4,4 @@ Expected a type of kind But found one of kind '(fun (type) (type))' Namely, - '(lam a_1 (type) (fun a_1 a_1))') \ No newline at end of file + '(lam a (type) (fun a a))') \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKindFullyApplied.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKindFullyApplied.type.golden index 6634145229d..cbc76b82358 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKindFullyApplied.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKindFullyApplied.type.golden @@ -4,4 +4,4 @@ Expected a type of kind But found one of kind '(fun (type) (type))' Namely, - '(lam a_1 (type) (fun a_1 a_1))') \ No newline at end of file + '(lam a (type) (fun a a))') \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKindWithCond.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKindWithCond.type.golden index 6634145229d..cbc76b82358 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKindWithCond.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteAtHigherKindWithCond.type.golden @@ -4,4 +4,4 @@ Expected a type of kind But found one of kind '(fun (type) (type))' Namely, - '(lam a_1 (type) (fun a_1 a_1))') \ No newline at end of file + '(lam a (type) (fun a a))') \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteUninstantiatedFullyApplied.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteUninstantiatedFullyApplied.type.golden index d82bc2d1e60..a21a8913ca4 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteUninstantiatedFullyApplied.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteUninstantiatedFullyApplied.type.golden @@ -2,6 +2,6 @@ Expected a term of type '(fun k l)' for some 'k' and 'l' But found one of type - '(all a_2 (type) (fun (con bool) (fun a_2 (fun a_2 a_2))))' + '(all a (type) (fun (con bool) (fun a (fun a a))))' Namely, '(builtin ifThenElse)') \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteUninstantiatedWithCond.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteUninstantiatedWithCond.type.golden index d82bc2d1e60..a21a8913ca4 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteUninstantiatedWithCond.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/iteUninstantiatedWithCond.type.golden @@ -2,6 +2,6 @@ Expected a term of type '(fun k l)' for some 'k' and 'l' But found one of type - '(all a_2 (type) (fun (con bool) (fun a_2 (fun a_2 a_2))))' + '(all a (type) (fun (con bool) (fun a (fun a a))))' Namely, '(builtin ifThenElse)') \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/polyError.type.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/polyError.type.golden index 25bc5d87a71..be5cc9e3fb3 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Golden/polyError.type.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Golden/polyError.type.golden @@ -1 +1 @@ -(Right (all a_1 (type) a_1)) \ No newline at end of file +(Right (all a (type) a)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/0.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/0.uplc.golden index 9f4e4813c90..fdbc1b65ee8 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/0.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/0.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 0 | mem: 0}) | BStep BVar causes ({cpu: 2176000 | mem: 13600}) | BStep BLamAbs causes ({cpu: 1472000 | mem: 9200}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/3.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/3.uplc.golden index c90e1999121..c1da85de793 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/3.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 0 | mem: 0}) | BStep BVar causes ({cpu: 2176000 | mem: 13600}) | BStep BLamAbs causes ({cpu: 1472000 | mem: 9200}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/6.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/6.uplc.golden index 36c0cb0fc75..cb8c5a1da45 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/6.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/6.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 0 | mem: 0}) | BStep BVar causes ({cpu: 2176000 | mem: 13600}) | BStep BLamAbs causes ({cpu: 1472000 | mem: 9200}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/9.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/9.uplc.golden index f69f6bbde9c..95ae1902625 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/9.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IdNat/9.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 0 | mem: 0}) | BStep BVar causes ({cpu: 2176000 | mem: 13600}) | BStep BLamAbs causes ({cpu: 1472000 | mem: 9200}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/0.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/0.uplc.golden index 9f4e4813c90..fdbc1b65ee8 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/0.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/0.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 0 | mem: 0}) | BStep BVar causes ({cpu: 2176000 | mem: 13600}) | BStep BLamAbs causes ({cpu: 1472000 | mem: 9200}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/1.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/1.uplc.golden index 62195414fac..83bb9621f8e 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/1.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 16000 | mem: 100}) | BStep BVar causes ({cpu: 2240000 | mem: 14000}) | BStep BLamAbs causes ({cpu: 1632000 | mem: 10200}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/2.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/2.uplc.golden index 3f4f55a1f16..daa53e2f4a2 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/2.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/2.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 32000 | mem: 200}) | BStep BVar causes ({cpu: 2256000 | mem: 14100}) | BStep BLamAbs causes ({cpu: 1664000 | mem: 10400}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/3.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/3.uplc.golden index 69feff17298..6de901bc1bb 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/3.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 48000 | mem: 300}) | BStep BVar causes ({cpu: 2272000 | mem: 14200}) | BStep BLamAbs causes ({cpu: 1696000 | mem: 10600}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/4.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/4.uplc.golden index 387b492343b..1be22bdf093 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/4.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/4.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 64000 | mem: 400}) | BStep BVar causes ({cpu: 2288000 | mem: 14300}) | BStep BLamAbs causes ({cpu: 1728000 | mem: 10800}) diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/5.uplc.golden b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/5.uplc.golden index 5c1148a0a87..e8843cd922b 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/5.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Machines/Budget/IfThenElse/5.uplc.golden @@ -1,47 +1,47 @@ -( (Right (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - f - (delay - (\z - f -> - z))))))))))))))))))))))) +( (Right delay + (\z-0 + f-1 -> + f-1 + (delay + (\z-2 + f-3 -> + f-3 + (delay + (\z-4 + f-5 -> + f-5 + (delay + (\z-6 + f-7 -> + f-7 + (delay + (\z-8 + f-9 -> + f-9 + (delay + (\z-10 + f-11 -> + f-11 + (delay + (\z-12 + f-13 -> + f-13 + (delay + (\z-14 + f-15 -> + f-15 + (delay + (\z-16 + f-17 -> + f-17 + (delay + (\z-18 + f-19 -> + f-19 + (delay + (\z-20 + f-21 -> + z-20)))))))))))))))))))))) , ({ tally: ({BStep BConst causes ({cpu: 80000 | mem: 500}) | BStep BVar causes ({cpu: 2304000 | mem: 14400}) | BStep BLamAbs causes ({cpu: 1760000 | mem: 11000}) diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden index 99e77d62902..9cf88689c14 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/1.uplc.golden @@ -1,7 +1,7 @@ (force [ [ - [ (force (builtin ifThenElse)) b_0 ] + [ (force (builtin ifThenElse)) b ] (delay (case (constr 0) (con integer 1) (con integer 2))) ] (delay (case (constr 1) (con integer 1) (con integer 2))) diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/2.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/2.uplc.golden index c73165d882d..d8da14e00ad 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/2.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/2.uplc.golden @@ -1,5 +1,5 @@ (case - [ [ [ (force (builtin ifThenElse)) b_0 ] t_1 ] (constr 1) ] + [ [ [ (force (builtin ifThenElse)) b ] t ] (constr 1) ] (con integer 1) (con integer 2) ) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden index 74f9f77952f..9e7f8874321 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/CaseOfCase/3.uplc.golden @@ -1,9 +1,9 @@ (force [ [ - [ (force (builtin ifThenElse)) b_0 ] - (delay (case (constr 0 x_1 xs_2) f_3 (con integer 2))) + [ (force (builtin ifThenElse)) b ] + (delay (case (constr 0 x xs) f (con integer 2))) ] - (delay (case (constr 1) f_3 (con integer 2))) + (delay (case (constr 1) f (con integer 2))) ] ) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/callsiteInline.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/callsiteInline.uplc.golden index b7c97937ae3..c762b72fa51 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/callsiteInline.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/callsiteInline.uplc.golden @@ -1 +1 @@ -((\a_5 -> f_1 (g_2 1 0) (a_5 2)) (\x_6 y_7 -> g_2 y_7 x_6)) \ No newline at end of file +(\a -> f (g 1 0) (a 2)) (\x y -> g y x) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/cse1.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/cse1.uplc.golden index 8cb90c248e1..d7e4947f132 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/cse1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/cse1.uplc.golden @@ -1,12 +1,12 @@ -(\x_6 y_7 -> - (\cse_8 -> - (\cse_9 -> - addInteger - cse_9 - (case - y_7 - [ (addInteger cse_9 (addInteger 3 x_6)) - , (addInteger cse_8 (addInteger 3 x_6)) - , (addInteger 4 x_6) ])) - (addInteger 1 cse_8)) - (addInteger 2 x_6)) \ No newline at end of file +\x y -> + (\cse -> + (\cse -> + addInteger + cse + (case + y + [ (addInteger cse (addInteger 3 x)) + , (addInteger cse (addInteger 3 x)) + , (addInteger 4 x) ])) + (addInteger 1 cse)) + (addInteger 2 x) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/cse2.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/cse2.uplc.golden index b7ad3cd4538..8fe2274bd5b 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/cse2.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/cse2.uplc.golden @@ -1,6 +1,6 @@ -(force - (force - (ifThenElse - (lessThanInteger 0 0) - (delay ((\cse_2 -> addInteger cse_2 cse_2) (addInteger 1 2))) - (delay (addInteger 1 2))))) \ No newline at end of file +force + (force + (ifThenElse + (lessThanInteger 0 0) + (delay ((\cse -> addInteger cse cse) (addInteger 1 2))) + (delay (addInteger 1 2)))) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/cse3.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/cse3.uplc.golden index 28f7f02ad95..f85dabf4e25 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/cse3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/cse3.uplc.golden @@ -1,6 +1,4 @@ -(\x_8 -> - (\cse_9 -> - f_3 - (addInteger 1 (addInteger cse_9 cse_9)) - (addInteger 2 (addInteger cse_9 cse_9))) - (addInteger 0 x_8)) \ No newline at end of file +\x -> + (\cse -> + f (addInteger 1 (addInteger cse cse)) (addInteger 2 (addInteger cse cse))) + (addInteger 0 x) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/cseExpensive.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/cseExpensive.uplc.golden index f2db2f58a9d..c098977a6ad 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/cseExpensive.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/cseExpensive.uplc.golden @@ -1,1171 +1,1169 @@ -((\cse_402 -> - (\cse_403 -> - (\cse_404 -> - (\cse_405 -> - (\cse_406 -> - (\cse_407 -> - (\cse_408 -> - (\cse_409 -> - (\cse_410 -> - (\cse_411 -> - (\cse_412 -> - (\cse_413 -> - (\cse_414 -> - (\cse_415 -> - (\cse_416 -> - (\cse_417 -> - (\cse_418 -> - (\cse_419 -> - (\cse_420 -> - (\cse_421 -> - (\cse_422 -> - (\cse_423 -> - (\cse_424 -> - (\cse_425 -> - (\cse_426 -> - (\cse_427 -> - (\cse_428 -> - (\cse_429 -> - (\cse_430 -> - (\cse_431 -> - (\cse_432 -> - (\cse_433 -> - (\cse_434 -> - (\cse_435 -> - (\cse_436 -> - (\cse_437 -> - (\cse_438 -> - (\cse_439 -> - (\cse_440 -> - (\cse_441 -> - (\cse_442 -> - (\cse_443 -> - (\cse_444 -> - (\cse_445 -> - (\cse_446 -> - (\cse_447 -> - (\cse_448 -> - (\cse_449 -> - (\cse_450 -> - (\cse_451 -> - (\cse_452 -> - (\cse_453 -> - (\cse_454 -> - (\cse_455 -> - (\cse_456 -> - (\cse_457 -> - (\cse_458 -> - (\cse_459 -> - (\cse_460 -> - (\cse_461 -> - (\cse_462 -> - (\cse_463 -> - (\cse_464 -> - (\cse_465 -> - (\cse_466 -> - (\cse_467 -> - (\cse_468 -> - (\cse_469 -> - (\cse_470 -> - (\cse_471 -> - (\cse_472 -> - (\cse_473 -> - (\cse_474 -> - (\cse_475 -> - (\cse_476 -> - (\cse_477 -> - (\cse_478 -> - (\cse_479 -> - (\cse_480 -> - (\cse_481 -> - (\cse_482 -> - (\cse_483 -> - (\cse_484 -> - (\cse_485 -> - (\cse_486 -> - (\cse_487 -> - (\cse_488 -> - (\cse_489 -> - (\cse_490 -> - (\cse_491 -> - (\cse_492 -> - (\cse_493 -> - (\cse_494 -> - (\cse_495 -> - (\cse_496 -> - (\cse_497 -> - (\cse_498 -> - (\cse_499 -> - (\cse_500 -> - (\cse_501 -> - (\cse_502 -> - (\cse_503 -> - (\cse_504 -> - (\cse_505 -> - (\cse_506 -> - (\cse_507 -> - (\cse_508 -> - (\cse_509 -> - (\cse_510 -> - (\cse_511 -> - (\cse_512 -> - (\cse_513 -> - (\cse_514 -> - (\cse_515 -> - (\cse_516 -> - (\cse_517 -> - (\cse_518 -> - (\cse_519 -> - (\cse_520 -> - (\cse_521 -> - (\cse_522 -> - (\cse_523 -> - (\cse_524 -> - (\cse_525 -> - (\cse_526 -> - (\cse_527 -> - (\cse_528 -> - (\cse_529 -> - (\cse_530 -> - (\cse_531 -> - (\cse_532 -> - (\cse_533 -> - (\cse_534 -> - (\cse_535 -> - (\cse_536 -> - (\cse_537 -> - (\cse_538 -> - (\cse_539 -> - (\cse_540 -> - (\cse_541 -> - (\cse_542 -> - (\cse_543 -> - (\cse_544 -> - (\cse_545 -> - (\cse_546 -> - (\cse_547 -> - (\cse_548 -> - (\cse_549 -> - (\cse_550 -> - (\cse_551 -> - (\cse_552 -> - (\cse_553 -> - (\cse_554 -> - (\cse_555 -> - (\cse_556 -> - (\cse_557 -> - (\cse_558 -> - (\cse_559 -> - (\cse_560 -> - (\cse_561 -> - (\cse_562 -> - (\cse_563 -> - (\cse_564 -> - (\cse_565 -> - (\cse_566 -> - (\cse_567 -> - (\cse_568 -> - (\cse_569 -> - (\cse_570 -> - (\cse_571 -> - (\cse_572 -> - (\cse_573 -> - (\cse_574 -> - (\cse_575 -> - (\cse_576 -> - (\cse_577 -> - (\cse_578 -> - (\cse_579 -> - (\cse_580 -> - (\cse_581 -> - (\cse_582 -> - (\cse_583 -> - (\cse_584 -> - (\cse_585 -> - (\cse_586 -> - (\cse_587 -> - (\cse_588 -> - (\cse_589 -> - (\cse_590 -> - (\cse_591 -> - (\cse_592 -> - (\cse_593 -> - (\cse_594 -> - (\cse_595 -> - (\cse_596 -> - (\cse_597 -> - (\cse_598 -> - (\cse_599 -> - (\cse_600 -> - (\cse_601 -> - (\cse_602 -> - (\cse_802 -> - addInteger - cse_802 - cse_802) - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - (addInteger - cse_537 - cse_417) - cse_601) - cse_485) - cse_410) - cse_493) - cse_476) - cse_552) - cse_489) - cse_563) - cse_549) - cse_431) - cse_555) - cse_445) - cse_422) - cse_503) - cse_437) - cse_504) - cse_499) - cse_565) - cse_514) - cse_579) - cse_569) - cse_440) - cse_582) - cse_454) - cse_448) - cse_516) - cse_466) - cse_532) - cse_521) - cse_595) - cse_534) - cse_446) - cse_423) - cse_481) - cse_413) - cse_515) - cse_500) - cse_554) - cse_492) - cse_594) - cse_570) - cse_428) - cse_558) - cse_467) - cse_449) - cse_506) - cse_439) - cse_507) - cse_522) - cse_587) - cse_510) - cse_576) - cse_599) - cse_468) - cse_585) - cse_458) - cse_473) - cse_544) - cse_463) - cse_529) - cse_547) - cse_415) - cse_539) - cse_566) - cse_596) - cse_479) - cse_556) - cse_494) - cse_426) - cse_505) - cse_490) - cse_517) - cse_545) - cse_432) - cse_509) - cse_441) - cse_571) - cse_455) - cse_438) - cse_456) - cse_501) - cse_519) - cse_461) - cse_580) - cse_523) - cse_443) - cse_583) - cse_403) - cse_450) - cse_471) - cse_409) - cse_533) - cse_474) - cse_589) - cse_536) - cse_442) - cse_572) - cse_483) - cse_560) - cse_469) - cse_502) - cse_508) - cse_487) - cse_588) - cse_524) - cse_429) - cse_512) - cse_416) - cse_452) - cse_459) - cse_434) - cse_460) - cse_475) - cse_590) - cse_464) - cse_577) - cse_600) - cse_418) - cse_586) - cse_407) - cse_421) - cse_540) - cse_412) - cse_530) - cse_548) - cse_564) - cse_433) - cse_520) - cse_597) - cse_480) - cse_511) - cse_495) - cse_478) - cse_553) - cse_491) - cse_567) - cse_447) - cse_528) - cse_557) - cse_541) - cse_525) - cse_404) - cse_538) - cse_405) - cse_497) - cse_568) - cse_411) - cse_575) - cse_573) - cse_543) - cse_584) - cse_457) - cse_550) - cse_420) - cse_462) - cse_427) - cse_424) - cse_592) - cse_436) - cse_542) - cse_526) - cse_484) - cse_513) - cse_419) - cse_498) - cse_551) - cse_488) - cse_591) - cse_574) - cse_531) - cse_561) - cse_470) - cse_546) - cse_408) - cse_535) - cse_402) - cse_425) - cse_593) - cse_414) - cse_578) - cse_602) - cse_472) - cse_581) - cse_453) - cse_477) - cse_444) - cse_465) - cse_430) - cse_451) - cse_518) - cse_435) - cse_562) - cse_598) - cse_482) - cse_559) - cse_496) - cse_527) - cse_406) - cse_486)) - (addInteger - 364 - 365)) - (addInteger - 4 - 5)) - (addInteger - 236 - 237)) - (addInteger - 108 - 109)) - (addInteger - 388 - 389)) - (addInteger - 260 - 261)) - (addInteger - 132 - 133)) - (addInteger - 62 - 63)) - (addInteger - 82 - 83)) - (addInteger - 358 - 359)) - (addInteger - 318 - 319)) - (addInteger - 338 - 339)) - (addInteger - 230 - 231)) - (addInteger - 190 - 191)) - (addInteger - 210 - 211)) - (addInteger - 102 - 103)) - (addInteger - 240 - 241)) - (addInteger - 112 - 113)) - (addInteger - 304 - 305)) - (addInteger - 176 - 177)) - (addInteger - 48 - 49)) - (addInteger - 368 - 369)) - (addInteger - 170 - 171)) - (addInteger - 42 - 43)) - (addInteger - 362 - 363)) - (addInteger - 234 - 235)) - (addInteger - 106 - 107)) - (addInteger - 298 - 299)) - (addInteger - 340 - 341)) - (addInteger - 300 - 301)) - (addInteger - 196 - 197)) - (addInteger - 156 - 157)) - (addInteger - 84 - 85)) - (addInteger - 44 - 45)) - (addInteger - 294 - 295)) - (addInteger - 274 - 275)) - (addInteger - 130 - 131)) - (addInteger - 38 - 39)) - (addInteger - 254 - 255)) - (addInteger - 18 - 19)) - (addInteger - 386 - 387)) - (addInteger - 344 - 345)) - (addInteger - 200 - 201)) - (addInteger - 392 - 393)) - (addInteger - 88 - 89)) - (addInteger - 280 - 281)) - (addInteger - 136 - 137)) - (addInteger - 24 - 25)) - (addInteger - 78 - 79)) - (addInteger - 270 - 271)) - (addInteger - 14 - 15)) - (addInteger - 334 - 335)) - (addInteger - 308 - 309)) - (addInteger - 20 - 21)) - (addInteger - 252 - 253)) - (addInteger - 124 - 125)) - (addInteger - 348 - 349)) - (addInteger - 148 - 149)) - (addInteger - 118 - 119)) - (addInteger - 302 - 303)) - (addInteger - 322 - 323)) - (addInteger - 282 - 283)) - (addInteger - 246 - 247)) - (addInteger - 128 - 129)) - (addInteger - 288 - 289)) - (addInteger - 0 - 1)) - (addInteger - 192 - 193)) - (addInteger - 352 - 353)) - (addInteger - 64 - 65)) - (addInteger - 186 - 187)) - (addInteger - 58 - 59)) - (addInteger - 342 - 343)) - (addInteger - 250 - 251)) - (addInteger - 122 - 123)) - (addInteger - 278 - 279)) - (addInteger - 396 - 397)) - (addInteger - 324 - 325)) - (addInteger - 284 - 285)) - (addInteger - 212 - 213)) - (addInteger - 172 - 173)) - (addInteger - 100 - 101)) - (addInteger - 60 - 61)) - (addInteger - 258 - 259)) - (addInteger - 166 - 167)) - (addInteger - 382 - 383)) - (addInteger - 146 - 147)) - (addInteger - 54 - 55)) - (addInteger - 74 - 75)) - (addInteger - 40 - 41)) - (addInteger - 328 - 329)) - (addInteger - 216 - 217)) - (addInteger - 264 - 265)) - (addInteger - 104 - 105)) - (addInteger - 152 - 153)) - (addInteger - 206 - 207)) - (addInteger - 98 - 99)) - (addInteger - 94 - 95)) - (addInteger - 142 - 143)) - (addInteger - 34 - 35)) - (addInteger - 30 - 31)) - (addInteger - 204 - 205)) - (addInteger - 164 - 165)) - (addInteger - 76 - 77)) - (addInteger - 36 - 37)) - (addInteger - 332 - 333)) - (addInteger - 292 - 293)) - (addInteger - 394 - 395)) - (addInteger - 266 - 267)) - (addInteger - 138 - 139)) - (addInteger - 10 - 11)) - (addInteger - 80 - 81)) - (addInteger - 272 - 273)) - (addInteger - 144 - 145)) - (addInteger - 16 - 17)) - (addInteger - 336 - 337)) - (addInteger - 208 - 209)) - (addInteger - 400 - 401)) - (addInteger - 6 - 7)) - (addInteger - 326 - 327)) - (addInteger - 198 - 199)) - (addInteger - 390 - 391)) - (addInteger - 70 - 71)) - (addInteger - 262 - 263)) - (addInteger - 134 - 135)) - (addInteger - 268 - 269)) - (addInteger - 372 - 373)) - (addInteger - 12 - 13)) - (addInteger - 228 - 229)) - (addInteger - 188 - 189)) - (addInteger - 116 - 117)) - (addInteger - 366 - 367)) - (addInteger - 182 - 183)) - (addInteger - 346 - 347)) - (addInteger - 202 - 203)) - (addInteger - 110 - 111)) - (addInteger - 90 - 91)) - (addInteger - 56 - 57)) - (addInteger - 376 - 377)) - (addInteger - 232 - 233)) - (addInteger - 120 - 121)) - (addInteger - 312 - 313)) - (addInteger - 168 - 169)) - (addInteger - 226 - 227)) - (addInteger - 222 - 223)) - (addInteger - 114 - 115)) - (addInteger - 306 - 307)) - (addInteger - 162 - 163)) - (addInteger - 158 - 159)) - (addInteger - 50 - 51)) - (addInteger - 370 - 371)) - (addInteger - 220 - 221)) - (addInteger - 380 - 381)) - (addInteger - 180 - 181)) - (addInteger - 92 - 93)) - (addInteger - 52 - 53)) - (addInteger - 276 - 277)) - (addInteger - 66 - 67)) - (addInteger - 26 - 27)) - (addInteger - 374 - 375)) - (addInteger - 174 - 175)) - (addInteger - 194 - 195)) - (addInteger - 154 - 155)) - (addInteger - 46 - 47)) - (addInteger - 96 - 97)) - (addInteger - 160 - 161)) - (addInteger - 32 - 33)) - (addInteger - 320 - 321)) - (addInteger - 384 - 385)) - (addInteger - 224 - 225)) - (addInteger - 256 - 257)) - (addInteger - 150 - 151)) - (addInteger - 22 - 23)) - (addInteger - 378 - 379)) - (addInteger - 214 - 215)) - (addInteger - 86 - 87)) - (addInteger - 314 - 315)) - (addInteger - 140 - 141)) - (addInteger - 356 - 357)) - (addInteger - 316 - 317)) - (addInteger - 68 - 69)) - (addInteger - 28 - 29)) - (addInteger - 244 - 245)) - (addInteger 310 311)) - (addInteger 330 331)) - (addInteger 238 239)) - (addInteger 2 3)) - (addInteger 218 219)) - (addInteger 126 127)) - (addInteger 360 361)) - (addInteger 72 73)) - (addInteger 248 249)) - (addInteger 296 297)) - (addInteger 8 9)) - (addInteger 184 185)) - (addInteger 350 351)) - (addInteger 242 243)) - (addInteger 398 399)) - (addInteger 290 291)) - (addInteger 286 287)) - (addInteger 178 179)) - (addInteger 354 355)) \ No newline at end of file +(\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + (\cse -> + addInteger + cse + cse) + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + (addInteger + cse + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse) + cse)) + (addInteger + 364 + 365)) + (addInteger + 4 + 5)) + (addInteger + 236 + 237)) + (addInteger + 108 + 109)) + (addInteger + 388 + 389)) + (addInteger + 260 + 261)) + (addInteger + 132 + 133)) + (addInteger + 62 + 63)) + (addInteger + 82 + 83)) + (addInteger + 358 + 359)) + (addInteger + 318 + 319)) + (addInteger + 338 + 339)) + (addInteger + 230 + 231)) + (addInteger + 190 + 191)) + (addInteger + 210 + 211)) + (addInteger + 102 + 103)) + (addInteger + 240 + 241)) + (addInteger + 112 + 113)) + (addInteger + 304 + 305)) + (addInteger + 176 + 177)) + (addInteger + 48 + 49)) + (addInteger + 368 + 369)) + (addInteger + 170 + 171)) + (addInteger + 42 + 43)) + (addInteger + 362 + 363)) + (addInteger + 234 + 235)) + (addInteger + 106 + 107)) + (addInteger + 298 + 299)) + (addInteger + 340 + 341)) + (addInteger + 300 + 301)) + (addInteger + 196 + 197)) + (addInteger + 156 + 157)) + (addInteger + 84 + 85)) + (addInteger + 44 + 45)) + (addInteger + 294 + 295)) + (addInteger + 274 + 275)) + (addInteger + 130 + 131)) + (addInteger + 38 + 39)) + (addInteger + 254 + 255)) + (addInteger + 18 + 19)) + (addInteger + 386 + 387)) + (addInteger + 344 + 345)) + (addInteger + 200 + 201)) + (addInteger + 392 + 393)) + (addInteger + 88 + 89)) + (addInteger + 280 + 281)) + (addInteger + 136 + 137)) + (addInteger + 24 + 25)) + (addInteger + 78 + 79)) + (addInteger + 270 + 271)) + (addInteger + 14 + 15)) + (addInteger + 334 + 335)) + (addInteger + 308 + 309)) + (addInteger + 20 + 21)) + (addInteger + 252 + 253)) + (addInteger + 124 + 125)) + (addInteger + 348 + 349)) + (addInteger + 148 + 149)) + (addInteger + 118 + 119)) + (addInteger + 302 + 303)) + (addInteger + 322 + 323)) + (addInteger + 282 + 283)) + (addInteger + 246 + 247)) + (addInteger + 128 + 129)) + (addInteger + 288 + 289)) + (addInteger + 0 + 1)) + (addInteger + 192 + 193)) + (addInteger + 352 + 353)) + (addInteger + 64 + 65)) + (addInteger + 186 + 187)) + (addInteger + 58 + 59)) + (addInteger + 342 + 343)) + (addInteger + 250 + 251)) + (addInteger + 122 + 123)) + (addInteger + 278 + 279)) + (addInteger + 396 + 397)) + (addInteger + 324 + 325)) + (addInteger + 284 + 285)) + (addInteger + 212 + 213)) + (addInteger + 172 + 173)) + (addInteger + 100 + 101)) + (addInteger + 60 + 61)) + (addInteger + 258 + 259)) + (addInteger + 166 + 167)) + (addInteger + 382 + 383)) + (addInteger + 146 + 147)) + (addInteger + 54 + 55)) + (addInteger + 74 + 75)) + (addInteger + 40 + 41)) + (addInteger + 328 + 329)) + (addInteger + 216 + 217)) + (addInteger + 264 + 265)) + (addInteger + 104 + 105)) + (addInteger + 152 + 153)) + (addInteger + 206 + 207)) + (addInteger + 98 + 99)) + (addInteger + 94 + 95)) + (addInteger + 142 + 143)) + (addInteger + 34 + 35)) + (addInteger + 30 + 31)) + (addInteger + 204 + 205)) + (addInteger + 164 + 165)) + (addInteger + 76 + 77)) + (addInteger + 36 + 37)) + (addInteger + 332 + 333)) + (addInteger + 292 + 293)) + (addInteger + 394 + 395)) + (addInteger + 266 + 267)) + (addInteger + 138 + 139)) + (addInteger + 10 + 11)) + (addInteger + 80 + 81)) + (addInteger + 272 + 273)) + (addInteger + 144 + 145)) + (addInteger + 16 + 17)) + (addInteger + 336 + 337)) + (addInteger + 208 + 209)) + (addInteger + 400 + 401)) + (addInteger + 6 + 7)) + (addInteger + 326 + 327)) + (addInteger + 198 + 199)) + (addInteger + 390 + 391)) + (addInteger + 70 + 71)) + (addInteger + 262 + 263)) + (addInteger + 134 + 135)) + (addInteger + 268 + 269)) + (addInteger + 372 + 373)) + (addInteger + 12 + 13)) + (addInteger + 228 + 229)) + (addInteger + 188 + 189)) + (addInteger + 116 + 117)) + (addInteger + 366 + 367)) + (addInteger + 182 + 183)) + (addInteger + 346 + 347)) + (addInteger + 202 + 203)) + (addInteger + 110 + 111)) + (addInteger + 90 + 91)) + (addInteger + 56 + 57)) + (addInteger + 376 + 377)) + (addInteger + 232 + 233)) + (addInteger + 120 + 121)) + (addInteger + 312 + 313)) + (addInteger + 168 + 169)) + (addInteger + 226 + 227)) + (addInteger + 222 + 223)) + (addInteger + 114 + 115)) + (addInteger + 306 + 307)) + (addInteger + 162 + 163)) + (addInteger + 158 + 159)) + (addInteger + 50 + 51)) + (addInteger + 370 + 371)) + (addInteger + 220 + 221)) + (addInteger + 380 + 381)) + (addInteger + 180 + 181)) + (addInteger + 92 + 93)) + (addInteger + 52 + 53)) + (addInteger + 276 + 277)) + (addInteger + 66 + 67)) + (addInteger + 26 + 27)) + (addInteger + 374 + 375)) + (addInteger + 174 + 175)) + (addInteger + 194 + 195)) + (addInteger + 154 + 155)) + (addInteger + 46 + 47)) + (addInteger + 96 + 97)) + (addInteger + 160 + 161)) + (addInteger + 32 + 33)) + (addInteger + 320 + 321)) + (addInteger + 384 + 385)) + (addInteger + 224 + 225)) + (addInteger + 256 + 257)) + (addInteger + 150 + 151)) + (addInteger + 22 + 23)) + (addInteger + 378 + 379)) + (addInteger + 214 + 215)) + (addInteger + 86 + 87)) + (addInteger + 314 + 315)) + (addInteger + 140 + 141)) + (addInteger + 356 + 357)) + (addInteger + 316 + 317)) + (addInteger + 68 + 69)) + (addInteger + 28 + 29)) + (addInteger 244 245)) + (addInteger 310 311)) + (addInteger 330 331)) + (addInteger 238 239)) + (addInteger 2 3)) + (addInteger 218 219)) + (addInteger 126 127)) + (addInteger 360 361)) + (addInteger 72 73)) + (addInteger 248 249)) + (addInteger 296 297)) + (addInteger 8 9)) + (addInteger 184 185)) + (addInteger 350 351)) + (addInteger 242 243)) + (addInteger 398 399)) + (addInteger 290 291)) + (addInteger 286 287)) + (addInteger 178 179)) + (addInteger 354 355) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/extraDelays.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/extraDelays.uplc.golden index df03e678730..c657cebfec2 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/extraDelays.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/extraDelays.uplc.golden @@ -1 +1 @@ -(delay 1) \ No newline at end of file +delay 1 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/floatDelay1.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/floatDelay1.uplc.golden index 76314bfe356..b7b8ae1aa74 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/floatDelay1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/floatDelay1.uplc.golden @@ -1 +1 @@ -(addInteger 1 1) \ No newline at end of file +addInteger 1 1 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/floatDelay2.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/floatDelay2.uplc.golden index 5f9aeb2233e..87366c81f72 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/floatDelay2.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/floatDelay2.uplc.golden @@ -1 +1 @@ -((\a_1 -> addInteger (force a_1) (force a_1)) (delay (addInteger 1 2))) \ No newline at end of file +(\a -> addInteger (force a) (force a)) (delay (addInteger 1 2)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/floatDelay3.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/floatDelay3.uplc.golden index ed8ba6f3db4..eacbcc02d3f 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/floatDelay3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/floatDelay3.uplc.golden @@ -1 +1 @@ -(addInteger (force (delay 1)) (force (delay 1))) \ No newline at end of file +addInteger (force (delay 1)) (force (delay 1)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/forceDelayComplex.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/forceDelayComplex.uplc.golden index 50a3d500b30..9f652a4d85c 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/forceDelayComplex.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/forceDelayComplex.uplc.golden @@ -1 +1 @@ -(funcVar_7 1 2 "foo" "bar" 3 3) \ No newline at end of file +funcVar 1 2 "foo" "bar" 3 3 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiApply.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiApply.uplc.golden index 57132a23441..e3d9f788070 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiApply.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/forceDelayMultiApply.uplc.golden @@ -1 +1 @@ -(funcVar_4 1 2 3) \ No newline at end of file +funcVar 1 2 3 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure1.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure1.uplc.golden index e75aa445cac..a10b0484599 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure1.uplc.golden @@ -1 +1 @@ -((\a_2 b_3 -> a_2) error) \ No newline at end of file +(\a b -> a) error \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure2.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure2.uplc.golden index e75aa445cac..a10b0484599 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure2.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure2.uplc.golden @@ -1 +1 @@ -((\a_2 b_3 -> a_2) error) \ No newline at end of file +(\a b -> a) error \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure3.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure3.uplc.golden index e75aa445cac..a10b0484599 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure3.uplc.golden @@ -1 +1 @@ -((\a_2 b_3 -> a_2) error) \ No newline at end of file +(\a b -> a) error \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure4.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure4.uplc.golden index 414e00d57c3..08f14ca99e7 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlineImpure4.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlineImpure4.uplc.golden @@ -1 +1 @@ -((\a_3 b_4 -> a_3) (force a_2)) \ No newline at end of file +(\a b -> a) (force a) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlinePure1.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlinePure1.uplc.golden index bde3b1c0f1b..a89db790d73 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlinePure1.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlinePure1.uplc.golden @@ -1 +1 @@ -(\b_4 -> a_2) \ No newline at end of file +\b -> a \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlinePure2.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlinePure2.uplc.golden index bde3b1c0f1b..a89db790d73 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlinePure2.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlinePure2.uplc.golden @@ -1 +1 @@ -(\b_4 -> a_2) \ No newline at end of file +\b -> a \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlinePure3.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlinePure3.uplc.golden index 5946b96c2b6..e2e6423b7f6 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlinePure3.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlinePure3.uplc.golden @@ -1 +1 @@ -(\b_5 y_8 -> 1 1) \ No newline at end of file +\b y -> 1 1 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/inlinePure4.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/inlinePure4.uplc.golden index 5e1a936a2a0..74535e5d945 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/inlinePure4.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/inlinePure4.uplc.golden @@ -1 +1 @@ -(\b_5 -> (\x_8 y_9 -> x_8 x_8) (delay (error 1))) \ No newline at end of file +\b -> (\x y -> x x) (delay (error 1)) \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/interveningLambda.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/interveningLambda.uplc.golden index b9abc06d8e7..92880af7137 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/interveningLambda.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/interveningLambda.uplc.golden @@ -1 +1 @@ -(1 1) \ No newline at end of file +1 1 \ No newline at end of file diff --git a/plutus-core/untyped-plutus-core/test/Transform/multiApp.uplc.golden b/plutus-core/untyped-plutus-core/test/Transform/multiApp.uplc.golden index aa7d0034dc3..354bbaf3997 100644 --- a/plutus-core/untyped-plutus-core/test/Transform/multiApp.uplc.golden +++ b/plutus-core/untyped-plutus-core/test/Transform/multiApp.uplc.golden @@ -1 +1 @@ -(3 1 2) \ No newline at end of file +3 1 2 \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/onlyUseFirstField.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/onlyUseFirstField.uplc.golden index 08d62b79d6e..2f7d89a5bda 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/onlyUseFirstField.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/onlyUseFirstField.uplc.golden @@ -1,28 +1,28 @@ -program - 1.1.0 - (\d -> - (\tup -> - force - (force - (force ifThenElse - (equalsInteger 0 (force (force fstPair) tup)) - (delay - (delay - ((\l -> - (\l -> - (\l -> - (\ds -> - (\ds -> - (\ds -> - (\ds -> ds) - (unIData - (force headList - (force tailList l)))) - (unIData (force headList l))) - (unIData (force headList l))) - (unIData (force headList l))) - (force tailList l)) - (force tailList l)) - (force (force sndPair) tup)))) - (delay (delay error))))) - (unConstrData d)) \ No newline at end of file +(program + 1.1.0 + (\d -> + (\tup -> + force + (force + (force ifThenElse + (equalsInteger 0 (force (force fstPair) tup)) + (delay + (delay + ((\l -> + (\l -> + (\l -> + (\ds -> + (\ds -> + (\ds -> + (\ds -> ds) + (unIData + (force headList + (force tailList l)))) + (unIData (force headList l))) + (unIData (force headList l))) + (unIData (force headList l))) + (force tailList l)) + (force tailList l)) + (force (force sndPair) tup)))) + (delay (delay error))))) + (unConstrData d))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden index 11b4a4ebfe9..b78b1c5986f 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/patternMatching.uplc.golden @@ -1,68 +1,71 @@ -program - 1.1.0 - (\d -> - (\ds -> - (\ds -> - (\x -> - (\y -> - (\z -> - (\w -> - (\lessThanInteger -> - addInteger - (addInteger - (addInteger - (addInteger - (addInteger (force x) (force y)) - (force z)) - (force w)) - (force - (case - (lessThanInteger - (addInteger (force y) (force z)) - (addInteger (force x) (force w))) - [ (delay (addInteger (force x) (force z))) - , (delay - (addInteger (force y) (force w))) ]))) - (force - (case - (lessThanInteger - (addInteger (force z) (force y)) - (addInteger (force w) (force x))) - [ (delay (addInteger (force z) (force x))) - , (delay - (addInteger (force w) (force y))) ]))) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 []))) - (delay (case (force ds) [(\x y z w -> w)]))) - (delay (case (force ds) [(\x y z w -> z)]))) - (delay (case (force ds) [(\x y z w -> y)]))) - (delay (case (force ds) [(\x y z w -> x)]))) - (force ds)) - (delay - ((\tup -> - force - (force - (force ifThenElse - (equalsInteger 0 (force (force fstPair) tup)) - (delay - (delay - ((\l -> - (\l -> - (\l -> - (\z w -> - constr 0 - [ (unIData (force headList l)) - , (unIData (force headList l)) - , z - , w ]) - (unIData (force headList l)) - (unIData - (force headList (force tailList l)))) - (force tailList l)) - (force tailList l)) - (force (force sndPair) tup)))) - (delay (delay (case error [error])))))) - (unConstrData d)))) \ No newline at end of file +(program + 1.1.0 + (\d -> + (\ds -> + (\ds -> + (\x -> + (\y -> + (\z -> + (\w -> + (\lessThanInteger -> + addInteger + (addInteger + (addInteger + (addInteger + (addInteger (force x) (force y)) + (force z)) + (force w)) + (force + (case + (lessThanInteger + (addInteger (force y) (force z)) + (addInteger (force x) (force w))) + [ (delay (addInteger (force x) (force z))) + , (delay + (addInteger + (force y) + (force w))) ]))) + (force + (case + (lessThanInteger + (addInteger (force z) (force y)) + (addInteger (force w) (force x))) + [ (delay (addInteger (force z) (force x))) + , (delay + (addInteger (force w) (force y))) ]))) + (\x y -> + force ifThenElse + (lessThanInteger x y) + (constr 0 []) + (constr 1 []))) + (delay (case (force ds) [(\x y z w -> w)]))) + (delay (case (force ds) [(\x y z w -> z)]))) + (delay (case (force ds) [(\x y z w -> y)]))) + (delay (case (force ds) [(\x y z w -> x)]))) + (force ds)) + (delay + ((\tup -> + force + (force + (force ifThenElse + (equalsInteger 0 (force (force fstPair) tup)) + (delay + (delay + ((\l -> + (\l -> + (\l -> + (\z w -> + constr 0 + [ (unIData (force headList l)) + , (unIData (force headList l)) + , z + , w ]) + (unIData (force headList l)) + (unIData + (force headList + (force tailList l)))) + (force tailList l)) + (force tailList l)) + (force (force sndPair) tup)))) + (delay (delay (case error [error])))))) + (unConstrData d))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-manual.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-manual.uplc.golden index ad72444ea72..5648286c32f 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-manual.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields-manual.uplc.golden @@ -1,110 +1,111 @@ -program - 1.1.0 - (\d -> - (\int1Manual -> - (\x -> - (\int2Manual -> - (\y -> - (\int3Manual -> - (\z -> - (\int4Manual -> - (\w -> - (\lessThanInteger -> - addInteger - (addInteger - (addInteger - (addInteger (addInteger x y) z) - w) - (force - (case - (lessThanInteger - (addInteger y z) - (addInteger x w)) - [ (delay (addInteger x z)) - , (delay (addInteger y w)) ]))) +(program + 1.1.0 + (\d -> + (\int1Manual -> + (\x -> + (\int2Manual -> + (\y -> + (\int3Manual -> + (\z -> + (\int4Manual -> + (\w -> + (\lessThanInteger -> + addInteger + (addInteger + (addInteger + (addInteger (addInteger x y) z) + w) + (force + (case + (lessThanInteger + (addInteger y z) + (addInteger x w)) + [ (delay (addInteger x z)) + , (delay (addInteger y w)) ]))) + (force + (case + (lessThanInteger + (addInteger + (int3Manual d) + (int2Manual d)) + (addInteger + (int4Manual d) + (int1Manual d))) + [ (delay + (addInteger + (int3Manual d) + (int1Manual d))) + , (delay + (addInteger + (int4Manual d) + (int2Manual d))) ]))) + (\x y -> + force ifThenElse + (lessThanInteger x y) + (constr 0 []) + (constr 1 []))) + (int4Manual d)) + (\ds -> + (\tup -> + (\i -> + (\d -> + force + (force + (force ifThenElse + (equalsInteger 0 i) + (delay (delay (unIData d))) + (delay (delay error))))) + (force headList + (force tailList + (force tailList + (force tailList + (force (force sndPair) + tup)))))) + (force (force fstPair) tup)) + (unConstrData ds))) + (int3Manual d)) + (\ds -> + (\tup -> + (\i -> + (\d -> + force (force - (case - (lessThanInteger - (addInteger - (int3Manual d) - (int2Manual d)) - (addInteger - (int4Manual d) - (int1Manual d))) - [ (delay - (addInteger - (int3Manual d) - (int1Manual d))) - , (delay - (addInteger - (int4Manual d) - (int2Manual d))) ]))) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 []))) - (int4Manual d)) - (\ds -> - (\tup -> - (\i -> - (\d -> - force - (force - (force ifThenElse - (equalsInteger 0 i) - (delay (delay (unIData d))) - (delay (delay error))))) - (force headList - (force tailList - (force tailList - (force tailList - (force (force sndPair) tup)))))) - (force (force fstPair) tup)) - (unConstrData ds))) - (int3Manual d)) - (\ds -> - (\tup -> - (\i -> - (\d -> - force - (force - (force ifThenElse - (equalsInteger 0 i) - (delay (delay (unIData d))) - (delay (delay error))))) - (force headList - (force tailList - (force tailList - (force (force sndPair) tup))))) - (force (force fstPair) tup)) - (unConstrData ds))) - (int2Manual d)) - (\ds -> - (\tup -> - (\i -> - (\d -> - force - (force - (force ifThenElse - (equalsInteger 0 i) - (delay (delay (unIData d))) - (delay (delay error))))) - (force headList - (force tailList (force (force sndPair) tup)))) - (force (force fstPair) tup)) - (unConstrData ds))) - (int1Manual d)) - (\ds -> - (\tup -> - (\i -> - (\d -> - force - (force - (force ifThenElse - (equalsInteger 0 i) - (delay (delay (unIData d))) - (delay (delay error))))) - (force headList (force (force sndPair) tup))) - (force (force fstPair) tup)) - (unConstrData ds))) \ No newline at end of file + (force ifThenElse + (equalsInteger 0 i) + (delay (delay (unIData d))) + (delay (delay error))))) + (force headList + (force tailList + (force tailList + (force (force sndPair) tup))))) + (force (force fstPair) tup)) + (unConstrData ds))) + (int2Manual d)) + (\ds -> + (\tup -> + (\i -> + (\d -> + force + (force + (force ifThenElse + (equalsInteger 0 i) + (delay (delay (unIData d))) + (delay (delay error))))) + (force headList + (force tailList (force (force sndPair) tup)))) + (force (force fstPair) tup)) + (unConstrData ds))) + (int1Manual d)) + (\ds -> + (\tup -> + (\i -> + (\d -> + force + (force + (force ifThenElse + (equalsInteger 0 i) + (delay (delay (unIData d))) + (delay (delay error))))) + (force headList (force (force sndPair) tup))) + (force (force fstPair) tup)) + (unConstrData ds)))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden index 41fc327e750..8bd04859400 100644 --- a/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden +++ b/plutus-tx-plugin/test/AsData/Budget/9.6/recordFields.uplc.golden @@ -1,76 +1,76 @@ -program - 1.1.0 - (\d -> - (\`$mInts` -> - (\int -> - (\x -> - (\int -> - (\y -> - (\int -> - (\z -> - (\int -> - (\w -> - (\lessThanInteger -> - addInteger - (addInteger - (addInteger - (addInteger (addInteger x y) z) - w) - (force - (case - (lessThanInteger - (addInteger y z) - (addInteger x w)) - [ (delay (addInteger x z)) - , (delay (addInteger y w)) ]))) - (force - (case - (lessThanInteger - (addInteger (int d) (int d)) - (addInteger (int d) (int d))) - [ (delay - (addInteger (int d) (int d))) - , (delay - (addInteger - (int d) - (int d))) ]))) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 []))) - (int d)) - (\ds -> - `$mInts` - ds - (\ds ds ds ds -> ds) - (\void -> error))) - (int d)) - (\ds -> - `$mInts` ds (\ds ds ds ds -> ds) (\void -> error))) - (int d)) - (\ds -> `$mInts` ds (\ds ds ds ds -> ds) (\void -> error))) - (int d)) - (\ds -> `$mInts` ds (\ds ds ds ds -> ds) (\void -> error))) - (\scrut cont fail -> - (\tup -> - force - (force - (force ifThenElse - (equalsInteger 0 (force (force fstPair) tup)) - (delay - (delay - ((\l -> - (\l -> - (\l -> - cont - (unIData (force headList l)) - (unIData (force headList l)) - (unIData (force headList l)) - (unIData - (force headList (force tailList l)))) - (force tailList l)) - (force tailList l)) - (force (force sndPair) tup)))) - (delay (delay (fail ())))))) - (unConstrData scrut))) \ No newline at end of file +(program + 1.1.0 + (\d -> + (\`$mInts` -> + (\int -> + (\x -> + (\int -> + (\y -> + (\int -> + (\z -> + (\int -> + (\w -> + (\lessThanInteger -> + addInteger + (addInteger + (addInteger + (addInteger (addInteger x y) z) + w) + (force + (case + (lessThanInteger + (addInteger y z) + (addInteger x w)) + [ (delay (addInteger x z)) + , (delay (addInteger y w)) ]))) + (force + (case + (lessThanInteger + (addInteger (int d) (int d)) + (addInteger (int d) (int d))) + [ (delay + (addInteger (int d) (int d))) + , (delay + (addInteger + (int d) + (int d))) ]))) + (\x y -> + force ifThenElse + (lessThanInteger x y) + (constr 0 []) + (constr 1 []))) + (int d)) + (\ds -> + `$mInts` + ds + (\ds ds ds ds -> ds) + (\void -> error))) + (int d)) + (\ds -> + `$mInts` ds (\ds ds ds ds -> ds) (\void -> error))) + (int d)) + (\ds -> `$mInts` ds (\ds ds ds ds -> ds) (\void -> error))) + (int d)) + (\ds -> `$mInts` ds (\ds ds ds ds -> ds) (\void -> error))) + (\scrut cont fail -> + (\tup -> + force + (force + (force ifThenElse + (equalsInteger 0 (force (force fstPair) tup)) + (delay + (delay + ((\l -> + (\l -> + (\l -> + cont + (unIData (force headList l)) + (unIData (force headList l)) + (unIData (force headList l)) + (unIData + (force headList (force tailList l)))) + (force tailList l)) + (force tailList l)) + (force (force sndPair) tup)))) + (delay (delay (fail ())))))) + (unConstrData scrut)))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden index dcf32e53bb8..f72945d7c15 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allCheap.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 1 x) + (delay (delay (constr 1 []))) + (delay (delay (s s xs))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden index fc982f1e511..7f5ac34f297 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allEmptyList.uplc.golden @@ -1,17 +1,17 @@ -program - 1.1.0 - ((\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) - (constr 0 [])) \ No newline at end of file +(program + 1.1.0 + ((\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 1 x) + (delay (delay (constr 1 []))) + (delay (delay (s s xs))))))) ])) + (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden index da446625b39..b23a61ea97d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/allExpensive.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 11 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 11 x) + (delay (delay (constr 1 []))) + (delay (delay (s s xs))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andCheap.uplc.golden index bd9a319fec4..14a11f1e466 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andCheap.uplc.golden @@ -1,35 +1,35 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (case x [(delay (s s xs)), (delay (constr 1 []))]))) ])) - (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (case x [(delay (s s xs)), (delay (constr 1 []))]))) ])) + (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andExpensive.uplc.golden index 667cecfd0ab..17225b1f9a9 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andExpensive.uplc.golden @@ -1,35 +1,35 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (case x [(delay (s s xs)), (delay (constr 1 []))]))) ])) - (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 0 []) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (case x [(delay (s s xs)), (delay (constr 1 []))]))) ])) + (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 0 []) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden index fc2213b5a3e..de616d547c6 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithGHCOpts.uplc.golden @@ -1,16 +1,16 @@ -program - 1.1.0 - ((\x y -> - force - (force - (force ifThenElse - (lessThanInteger x 3) - (delay - (delay - (force ifThenElse - (lessThanInteger y 3) - (constr 0 []) - (constr 1 [])))) - (delay (delay (constr 1 [])))))) - 4 - 4) \ No newline at end of file +(program + 1.1.0 + ((\x y -> + force + (force + (force ifThenElse + (lessThanInteger x 3) + (delay + (delay + (force ifThenElse + (lessThanInteger y 3) + (constr 0 []) + (constr 1 [])))) + (delay (delay (constr 1 [])))))) + 4 + 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden index 6698c4406e8..94abf5891ab 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithLocal.uplc.golden @@ -1,15 +1,15 @@ -program - 1.1.0 - ((\x y -> - force - ((\lessThanInteger -> - case - (lessThanInteger x 3) - [(delay (lessThanInteger y 3)), (delay (constr 1 []))]) - (\x y -> - force ifThenElse - (lessThanInteger x y) - (constr 0 []) - (constr 1 [])))) - 4 - 4) \ No newline at end of file +(program + 1.1.0 + ((\x y -> + force + ((\lessThanInteger -> + case + (lessThanInteger x 3) + [(delay (lessThanInteger y 3)), (delay (constr 1 []))]) + (\x y -> + force ifThenElse + (lessThanInteger x y) + (constr 0 []) + (constr 1 [])))) + 4 + 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden index d35e63fd029..85a233cb9d1 100644 --- a/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/andWithoutGHCOpts.uplc.golden @@ -1,14 +1,14 @@ -program - 1.1.0 - ((\x y -> - force - (case - (force ifThenElse (lessThanInteger x 3) (constr 0 []) (constr 1 [])) - [ (delay - (force ifThenElse - (lessThanInteger y 3) - (constr 0 []) - (constr 1 []))) - , (delay (constr 1 [])) ])) - 4 - 4) \ No newline at end of file +(program + 1.1.0 + ((\x y -> + force + (case + (force ifThenElse (lessThanInteger x 3) (constr 0 []) (constr 1 [])) + [ (delay + (force ifThenElse + (lessThanInteger y 3) + (constr 0 []) + (constr 1 []))) + , (delay (constr 1 [])) ])) + 4 + 4)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden index 4381c9ee774..f8ea3ee5874 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyCheap.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 10 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 []))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 10 x) + (delay (delay (s s xs))) + (delay (delay (constr 0 []))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden index cd13fa93d59..449b242be9a 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyEmptyList.uplc.golden @@ -1,17 +1,17 @@ -program - 1.1.0 - ((\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 []))))))) ])) - (constr 0 [])) \ No newline at end of file +(program + 1.1.0 + ((\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 1 x) + (delay (delay (s s xs))) + (delay (delay (constr 0 []))))))) ])) + (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden index ebbe16491b7..2d4571c1c61 100644 --- a/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/anyExpensive.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 []))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 1 x) + (delay (delay (s s xs))) + (delay (delay (constr 0 []))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/applicative.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/applicative.uplc.golden index b77b75470ce..1efbfc301cc 100644 --- a/plutus-tx-plugin/test/Budget/9.6/applicative.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/applicative.uplc.golden @@ -1 +1 @@ -program 1.1.0 (constr 0 [(addInteger 1 2)]) \ No newline at end of file +(program 1.1.0 (constr 0 [(addInteger 1 2)])) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden index 44c70cb43aa..1030e9687ba 100644 --- a/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/builtinListIndexing.uplc.golden @@ -1,21 +1,21 @@ -program - 1.1.0 - ((\go d -> go (unListData d) 5) - ((\s -> s s) - (\s xs i -> - force (force chooseList) - xs - (\ds -> error) - (\ds ds -> - (\hd -> - (\tl -> - force - (force - (force ifThenElse - (equalsInteger 0 i) - (delay (delay hd)) - (delay (delay (s s tl (subtractInteger i 1))))))) - (force tailList xs)) - (force headList xs)) - (constr 0 []) - (constr 0 [])))) \ No newline at end of file +(program + 1.1.0 + ((\go d -> go (unListData d) 5) + ((\s -> s s) + (\s xs i -> + force (force chooseList) + xs + (\ds -> error) + (\ds ds -> + (\hd -> + (\tl -> + force + (force + (force ifThenElse + (equalsInteger 0 i) + (delay (delay hd)) + (delay (delay (s s tl (subtractInteger i 1))))))) + (force tailList xs)) + (force headList xs)) + (constr 0 []) + (constr 0 []))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden index 7c62da077af..e7b8462b08b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccL.uplc.golden @@ -1,20 +1,20 @@ -program - 1.1.0 - ((\fix1 -> - (\go -> - (\ls -> go 42 ls) - (fix1 - (\go n -> - force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 [1, (go (subtractInteger n 1))])))))) - 1000)) - (fix1 - (\go acc ds -> - force (case ds [(delay acc), (\x xs -> delay (go acc xs))])))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + (\go -> + (\ls -> go 42 ls) + (fix1 + (\go n -> + force + (force + (force ifThenElse + (lessThanEqualsInteger n 0) + (delay (delay (constr 0 []))) + (delay + (delay + (constr 1 [1, (go (subtractInteger n 1))])))))) + 1000)) + (fix1 + (\go acc ds -> + force (case ds [(delay acc), (\x xs -> delay (go acc xs))])))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden index 800efaa9342..0ff0d343daa 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constAccR.uplc.golden @@ -1,16 +1,16 @@ -program - 1.1.0 - ((\fix1 -> - fix1 - (\go ds -> force (case ds [(delay 42), (\x xs -> delay (go xs))])) - (fix1 - (\go n -> - force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay (constr 1 [1, (go (subtractInteger n 1))])))))) - 1000)) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + fix1 + (\go ds -> force (case ds [(delay 42), (\x xs -> delay (go xs))])) + (fix1 + (\go n -> + force + (force + (force ifThenElse + (lessThanEqualsInteger n 0) + (delay (delay (constr 0 []))) + (delay + (delay (constr 1 [1, (go (subtractInteger n 1))])))))) + 1000)) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden index 45caad50b05..124fd03ada5 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElL.uplc.golden @@ -1,20 +1,20 @@ -program - 1.1.0 - ((\fix1 -> - (\go -> - (\ls -> go 42 ls) - (fix1 - (\go n -> - force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 [1, (go (subtractInteger n 1))])))))) - 1000)) - (fix1 - (\go acc ds -> - force (case ds [(delay acc), (\x xs -> delay (go x xs))])))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + (\go -> + (\ls -> go 42 ls) + (fix1 + (\go n -> + force + (force + (force ifThenElse + (lessThanEqualsInteger n 0) + (delay (delay (constr 0 []))) + (delay + (delay + (constr 1 [1, (go (subtractInteger n 1))])))))) + 1000)) + (fix1 + (\go acc ds -> + force (case ds [(delay acc), (\x xs -> delay (go x xs))])))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden index e25b748ade3..10ecc6525c2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/constElR.uplc.golden @@ -1,17 +1,17 @@ -program - 1.1.0 - ((\fix1 -> - fix1 - (\go ds -> - force (case ds [(delay 42), (\x xs -> delay ((\ds -> x) (go xs)))])) - (fix1 - (\go n -> - force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay (constr 1 [1, (go (subtractInteger n 1))])))))) - 1000)) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + fix1 + (\go ds -> + force (case ds [(delay 42), (\x xs -> delay ((\ds -> x) (go xs)))])) + (fix1 + (\go n -> + force + (force + (force ifThenElse + (lessThanEqualsInteger n 0) + (delay (delay (constr 0 []))) + (delay + (delay (constr 1 [1, (go (subtractInteger n 1))])))))) + 1000)) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden index 4232b06ff2f..fa3edc63c34 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemCheap.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (equalsInteger 1 x) - (delay (delay (constr 0 []))) - (delay (delay (s s xs))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (equalsInteger 1 x) + (delay (delay (constr 0 []))) + (delay (delay (s s xs))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden index d7dd66f957f..e2053411e8d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/elemExpensive.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay (delay (constr 0 []))) - (delay (delay (s s xs))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (equalsInteger 0 x) + (delay (delay (constr 0 []))) + (delay (delay (s s xs))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden index 72944c2b38d..72304b4ad4e 100644 --- a/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/filter.uplc.golden @@ -1,41 +1,41 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - ((\xs -> - force - (force - (force ifThenElse - (equalsInteger 0 (modInteger x 2)) - (delay (delay (constr 1 [x, xs]))) - (delay (delay xs))))) - (s s xs))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + ((\xs -> + force + (force + (force ifThenElse + (equalsInteger 0 (modInteger x 2)) + (delay (delay (constr 1 [x, xs]))) + (delay (delay xs))))) + (s s xs))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden index 25048a59683..d905d620a00 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findCheap.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 10 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 [x]))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 10 x) + (delay (delay (s s xs))) + (delay (delay (constr 0 [x]))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden index e165c572738..eebdf7cdfb4 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findEmptyList.uplc.golden @@ -1,17 +1,17 @@ -program - 1.1.0 - ((\s -> s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 [x]))))))) ])) - (constr 0 [])) \ No newline at end of file +(program + 1.1.0 + ((\s -> s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 1 x) + (delay (delay (s s xs))) + (delay (delay (constr 0 [x]))))))) ])) + (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden index 26c93b81b0c..1182f5d3ca5 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findExpensive.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay (s s xs))) - (delay (delay (constr 0 [x]))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 1 x) + (delay (delay (s s xs))) + (delay (delay (constr 0 [x]))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden index 0cabbbe10bb..360bcd0e178 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexCheap.uplc.golden @@ -1,40 +1,41 @@ -program - 1.1.0 - ((\s -> - s s) - (\s i ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 10 x) - (delay (delay ((\x -> s s x) (addInteger 1 i) xs))) - (delay (delay (constr 0 [i]))))))) ])) - 0 - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s i ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 10 x) + (delay + (delay ((\x -> s s x) (addInteger 1 i) xs))) + (delay (delay (constr 0 [i]))))))) ])) + 0 + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden index 8732da6d7c4..4ab11b04206 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexEmptyList.uplc.golden @@ -1,18 +1,19 @@ -program - 1.1.0 - ((\s -> s s) - (\s i ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay ((\x -> s s x) (addInteger 1 i) xs))) - (delay (delay (constr 0 [i]))))))) ])) - 0 - (constr 0 [])) \ No newline at end of file +(program + 1.1.0 + ((\s -> s s) + (\s i ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 1 x) + (delay + (delay ((\x -> s s x) (addInteger 1 i) xs))) + (delay (delay (constr 0 [i]))))))) ])) + 0 + (constr 0 []))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden index 60ee8bf16e9..ae2f5416988 100644 --- a/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/findIndexExpensive.uplc.golden @@ -1,40 +1,41 @@ -program - 1.1.0 - ((\s -> - s s) - (\s i ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger 1 x) - (delay (delay ((\x -> s s x) (addInteger 1 i) xs))) - (delay (delay (constr 0 [i]))))))) ])) - 0 - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s i ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger 1 x) + (delay + (delay ((\x -> s s x) (addInteger 1 i) xs))) + (delay (delay (constr 0 [i]))))))) ])) + 0 + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden index 0af5bdc3a06..b13cb2e381f 100644 --- a/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/gte0.uplc.golden @@ -1,28 +1,28 @@ -program - 1.1.0 - ((\fix1 -> - fix1 - (\go ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanInteger x 0) - (delay (delay (constr 1 []))) - (delay (delay (go xs))))))) ])) - (fix1 - (\go n -> - force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay (constr 1 [0, (go (subtractInteger n 1))])))))) - 1000)) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + fix1 + (\go ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanInteger x 0) + (delay (delay (constr 1 []))) + (delay (delay (go xs))))))) ])) + (fix1 + (\go n -> + force + (force + (force ifThenElse + (lessThanEqualsInteger n 0) + (delay (delay (constr 0 []))) + (delay + (delay (constr 1 [0, (go (subtractInteger n 1))])))))) + 1000)) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/ifThenElse1.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/ifThenElse1.uplc.golden index 17cc51cac6d..ad1e04602ac 100644 --- a/plutus-tx-plugin/test/Budget/9.6/ifThenElse1.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/ifThenElse1.uplc.golden @@ -1 +1 @@ -program 1.1.0 5 \ No newline at end of file +(program 1.1.0 5) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/ifThenElse2.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/ifThenElse2.uplc.golden index c2373c0e794..7cf8a1f4286 100644 --- a/plutus-tx-plugin/test/Budget/9.6/ifThenElse2.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/ifThenElse2.uplc.golden @@ -1 +1 @@ -program 1.1.0 18 \ No newline at end of file +(program 1.1.0 18) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden index 61555170f17..842a6a8312b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/listIndexing.uplc.golden @@ -1,21 +1,21 @@ -program - 1.1.0 - ((\go xs -> go 5 xs) - ((\s -> s s) - (\s ds ds -> - force - (case - ds - [ (delay error) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (equalsInteger 0 ds) - (delay (delay x)) - (delay - (delay - ((\x -> s s x) - (subtractInteger ds 1) - xs))))))) ])))) \ No newline at end of file +(program + 1.1.0 + ((\go xs -> go 5 xs) + ((\s -> s s) + (\s ds ds -> + force + (case + ds + [ (delay error) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (equalsInteger 0 ds) + (delay (delay x)) + (delay + (delay + ((\x -> s s x) + (subtractInteger ds 1) + xs))))))) ]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden index 4f724add0f4..5698af36e16 100644 --- a/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/lte0.uplc.golden @@ -1,28 +1,28 @@ -program - 1.1.0 - ((\fix1 -> - fix1 - (\go ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (lessThanEqualsInteger x 0) - (delay (delay (go xs))) - (delay (delay (constr 1 []))))))) ])) - (fix1 - (\go n -> - force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay (constr 1 [0, (go (subtractInteger n 1))])))))) - 1000)) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + fix1 + (\go ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (lessThanEqualsInteger x 0) + (delay (delay (go xs))) + (delay (delay (constr 1 []))))))) ])) + (fix1 + (\go n -> + force + (force + (force ifThenElse + (lessThanEqualsInteger n 0) + (delay (delay (constr 0 []))) + (delay + (delay (constr 1 [0, (go (subtractInteger n 1))])))))) + 1000)) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden index 694e318954f..e17a681a758 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map1.uplc.golden @@ -1,484 +1,486 @@ -program - 1.1.0 - ((\fix1 -> - (\`$fEnumBool_$cenumFromTo` -> - (\go -> - (\go -> - (\`$fShowBuiltinByteString_$cshowsPrec` -> - (\go -> - (\go -> - (\concatBuiltinStrings - n -> - (\nt -> - (\nt -> - (\lookup -> - constr 0 - [ (lookup (\i -> iData i) unBData n nt) - , (lookup - (\i -> iData i) - unBData - (addInteger 5 n) - nt) - , (lookup - (\i -> iData i) - unBData - (addInteger 10 n) - nt) - , (lookup - (\i -> iData i) - unBData - (addInteger 20 n) - nt) - , (lookup - (\i -> iData i) - unBData - (addInteger 5 n) - nt) ]) - (\`$dToData` - `$dUnsafeFromData` - ds - ds -> - force - (case - ((\k -> - fix1 - (\go - xs -> - force - (force chooseList) - xs - (\ds -> constr 1 []) - (\ds -> - (\hd -> - force - (force - (force - ifThenElse - (equalsData - k - (force - (force - fstPair) - hd)) - (delay - (delay - ((\ds -> - constr 0 - [ (force - (force - sndPair) - hd) ]) - (force - tailList - xs)))) - (delay - (delay - (go - (force - tailList - xs))))))) - (force headList xs)) - (constr 0 [])) - ds) - (`$dToData` ds)) - [ (\a -> - delay - (constr 0 - [(`$dUnsafeFromData` a)])) - , (delay (constr 1 [])) ]))) - ((\k -> - fix1 - (\go - xs -> - force - (force chooseList) - xs - (\ds -> []) - (\ds -> - (\hd -> - (\tl -> - force - (force - (force - ifThenElse - (equalsData - k - (force - (force - fstPair) - hd)) - (delay (delay tl)) - (delay - (delay - (force - mkCons - hd - (go - tl))))))) - (force tailList xs)) - (force headList xs)) - (constr 0 [])) - nt) - (iData (addInteger 5 n)))) - ((\z -> - (\go eta -> - go eta) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay z) - , (\y - ys -> - delay - ((\ds -> - (\ds - ds -> - (\k -> - (\a -> - fix1 - (\go - xs -> - force - (force - chooseList) - xs - (\ds -> - force - mkCons - (mkPairData - k - a) - [ ]) - (\ds -> - (\hd -> - (\tl -> - force - (force - (force - ifThenElse - (equalsData - k - (force - (force - fstPair) - hd)) - (delay - (delay - (force - mkCons - (mkPairData - k - a) - tl))) - (delay - (delay - (force - mkCons - hd - (go - tl))))))) - (force - tailList - xs)) - (force - headList - xs)) - (constr 0 - [])) - ds) - (bData ds)) - (iData ds)) - (encodeUtf8 - (concatBuiltinStrings - (`$fShowBuiltinByteString_$cshowsPrec` - 0 - y - (constr 0 - []))))) - (addInteger n y) - (go ys))) ])))) - (force mkCons (mkPairData (iData n) (B #30)) []) - (`$fEnumBool_$cenumFromTo` 1 10))) - (fix1 - (\concatBuiltinStrings - ds -> - case - ds - [ "" - , (\x +(program + 1.1.0 + ((\fix1 -> + (\`$fEnumBool_$cenumFromTo` -> + (\go -> + (\go -> + (\`$fShowBuiltinByteString_$cshowsPrec` -> + (\go -> + (\go -> + (\concatBuiltinStrings + n -> + (\nt -> + (\nt -> + (\lookup -> + constr 0 + [ (lookup (\i -> iData i) unBData n nt) + , (lookup + (\i -> iData i) + unBData + (addInteger 5 n) + nt) + , (lookup + (\i -> iData i) + unBData + (addInteger 10 n) + nt) + , (lookup + (\i -> iData i) + unBData + (addInteger 20 n) + nt) + , (lookup + (\i -> iData i) + unBData + (addInteger 5 n) + nt) ]) + (\`$dToData` + `$dUnsafeFromData` + ds ds -> force (case - ds - [ (delay x) - , (\ipv - ipv -> - delay - (case - ((\n -> - force - (force + ((\k -> + fix1 + (\go + xs -> + force + (force chooseList) + xs + (\ds -> constr 1 []) + (\ds -> + (\hd -> + force (force - ifThenElse - (lessThanEqualsInteger - n - 0) - (delay + (force + ifThenElse + (equalsData + k + (force + (force + fstPair) + hd)) (delay - (constr 0 - [ (constr 0 - [ ]) - , ds ]))) - (delay + (delay + ((\ds -> + constr 0 + [ (force + (force + sndPair) + hd) ]) + (force + tailList + xs)))) (delay - (force - go - n - ds)))))) - (divideInteger - (go ds) - 2)) - [ (\ipv - ipv -> - appendString - (concatBuiltinStrings - ipv) - (concatBuiltinStrings - ipv)) ])) ])) ]))) - (fix1 - (\go ds -> - force - (case - ds - [ (delay 0) - , (\x xs -> - delay (addInteger 1 (go xs))) ])))) - (fix1 - (\go - arg -> - delay - (\ds - ds -> - force - (case - ds - [ (delay - (constr 0 - [(constr 0 []), (constr 0 [])])) - , (\y - ys -> - delay - (force - (force - (force - ifThenElse - (equalsInteger 1 ds) - (delay - (delay - (constr 0 - [ (constr 1 - [ y - , (constr 0 - []) ]) - , ys ]))) - (delay - (delay - (case - (force - (go - (delay - (\x -> - x))) - (subtractInteger - ds - 1) - ys) - [ (\zs - ws -> - constr 0 - [ (constr 1 - [ y - , zs ]) - , ws ]) ]))))))) ]))) - (delay (\x -> x)))) - (fix1 - (\`$fShowBuiltinByteString_$cshowsPrec` - p - n -> - force - (force - (force - ifThenElse - (lessThanInteger n 0) - (delay - (delay - (\eta -> - constr 1 - [ "-" - , (`$fShowBuiltinByteString_$cshowsPrec` - p - (subtractInteger 0 n) - eta) ]))) - (delay (delay (go (go (constr 0 []) n))))))))) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay (\x -> x)) - , (\x - xs -> - delay - ((\acc - eta -> - constr 1 - [ (force - (force - (force - ifThenElse - (equalsInteger 0 x) - (delay (delay "0")) - (delay - (delay + (delay + (go + (force + tailList + xs))))))) + (force headList xs)) + (constr 0 [])) + ds) + (`$dToData` ds)) + [ (\a -> + delay + (constr 0 + [(`$dUnsafeFromData` a)])) + , (delay (constr 1 [])) ]))) + ((\k -> + fix1 + (\go + xs -> + force + (force chooseList) + xs + (\ds -> []) + (\ds -> + (\hd -> + (\tl -> + force (force (force - (force - ifThenElse - (equalsInteger - 1 - x) + ifThenElse + (equalsData + k + (force + (force + fstPair) + hd)) + (delay (delay tl)) + (delay (delay - (delay "1")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - "2")) - (delay - (delay + (force + mkCons + hd + (go + tl))))))) + (force tailList xs)) + (force headList xs)) + (constr 0 [])) + nt) + (iData (addInteger 5 n)))) + ((\z -> + (\go eta -> + go eta) + (fix1 + (\go + ds -> + force + (case + ds + [ (delay z) + , (\y + ys -> + delay + ((\ds -> + (\ds + ds -> + (\k -> + (\a -> + fix1 + (\go + xs -> + force + (force + chooseList) + xs + (\ds -> + force + mkCons + (mkPairData + k + a) + [ ]) + (\ds -> + (\hd -> + (\tl -> + force (force (force - (force - ifThenElse - (equalsInteger - 3 - x) + ifThenElse + (equalsData + k + (force + (force + fstPair) + hd)) + (delay (delay - (delay - "3")) + (force + mkCons + (mkPairData + k + a) + tl))) + (delay (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 4 - x) - (delay - (delay - "4")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 5 - x) - (delay - (delay - "5")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 6 - x) - (delay - (delay - "6")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 7 - x) - (delay - (delay - "7")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 8 - x) - (delay - (delay - "8")) - (delay - (delay - (force - (force - ifThenElse - (equalsInteger - 9 - x) - (delay - "9") - (delay - "")))))))))))))))))))))))))))))))))))))))))))))))) - , (acc eta) ]) - (go xs))) ])))) - (fix1 - (\go acc n -> - (\x -> - force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay - (delay - (constr 1 [(remainderInteger n 10), acc]))) - (delay - (delay - (go - (constr 1 [(remainderInteger n 10), acc]) - x)))))) - (quotientInteger n 10)))) - (fix1 - (\`$fEnumBool_$cenumFromTo` x lim -> - force - (force - (force ifThenElse - (lessThanEqualsInteger x lim) - (delay - (delay - (constr 1 - [ x - , (`$fEnumBool_$cenumFromTo` - (addInteger 1 x) - lim) ]))) - (delay (delay (constr 0 [])))))))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file + (force + mkCons + hd + (go + tl))))))) + (force + tailList + xs)) + (force + headList + xs)) + (constr 0 + [ ])) + ds) + (bData ds)) + (iData ds)) + (encodeUtf8 + (concatBuiltinStrings + (`$fShowBuiltinByteString_$cshowsPrec` + 0 + y + (constr 0 + []))))) + (addInteger n y) + (go ys))) ])))) + (force mkCons + (mkPairData (iData n) (B #30)) + []) + (`$fEnumBool_$cenumFromTo` 1 10))) + (fix1 + (\concatBuiltinStrings + ds -> + case + ds + [ "" + , (\x + ds -> + force + (case + ds + [ (delay x) + , (\ipv + ipv -> + delay + (case + ((\n -> + force + (force + (force + ifThenElse + (lessThanEqualsInteger + n + 0) + (delay + (delay + (constr 0 + [ (constr 0 + [ ]) + , ds ]))) + (delay + (delay + (force + go + n + ds)))))) + (divideInteger + (go ds) + 2)) + [ (\ipv + ipv -> + appendString + (concatBuiltinStrings + ipv) + (concatBuiltinStrings + ipv)) ])) ])) ]))) + (fix1 + (\go ds -> + force + (case + ds + [ (delay 0) + , (\x xs -> + delay (addInteger 1 (go xs))) ])))) + (fix1 + (\go + arg -> + delay + (\ds + ds -> + force + (case + ds + [ (delay + (constr 0 + [(constr 0 []), (constr 0 [])])) + , (\y + ys -> + delay + (force + (force + (force + ifThenElse + (equalsInteger 1 ds) + (delay + (delay + (constr 0 + [ (constr 1 + [ y + , (constr 0 + []) ]) + , ys ]))) + (delay + (delay + (case + (force + (go + (delay + (\x -> + x))) + (subtractInteger + ds + 1) + ys) + [ (\zs + ws -> + constr 0 + [ (constr 1 + [ y + , zs ]) + , ws ]) ]))))))) ]))) + (delay (\x -> x)))) + (fix1 + (\`$fShowBuiltinByteString_$cshowsPrec` + p + n -> + force + (force + (force + ifThenElse + (lessThanInteger n 0) + (delay + (delay + (\eta -> + constr 1 + [ "-" + , (`$fShowBuiltinByteString_$cshowsPrec` + p + (subtractInteger 0 n) + eta) ]))) + (delay (delay (go (go (constr 0 []) n))))))))) + (fix1 + (\go + ds -> + force + (case + ds + [ (delay (\x -> x)) + , (\x + xs -> + delay + ((\acc + eta -> + constr 1 + [ (force + (force + (force + ifThenElse + (equalsInteger 0 x) + (delay (delay "0")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 1 + x) + (delay + (delay "1")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 2 + x) + (delay + (delay + "2")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 3 + x) + (delay + (delay + "3")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 4 + x) + (delay + (delay + "4")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 5 + x) + (delay + (delay + "5")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 6 + x) + (delay + (delay + "6")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 7 + x) + (delay + (delay + "7")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 8 + x) + (delay + (delay + "8")) + (delay + (delay + (force + (force + ifThenElse + (equalsInteger + 9 + x) + (delay + "9") + (delay + "")))))))))))))))))))))))))))))))))))))))))))))))) + , (acc eta) ]) + (go xs))) ])))) + (fix1 + (\go acc n -> + (\x -> + force + (force + (force ifThenElse + (equalsInteger 0 x) + (delay + (delay + (constr 1 [(remainderInteger n 10), acc]))) + (delay + (delay + (go + (constr 1 [(remainderInteger n 10), acc]) + x)))))) + (quotientInteger n 10)))) + (fix1 + (\`$fEnumBool_$cenumFromTo` x lim -> + force + (force + (force ifThenElse + (lessThanEqualsInteger x lim) + (delay + (delay + (constr 1 + [ x + , (`$fEnumBool_$cenumFromTo` + (addInteger 1 x) + lim) ]))) + (delay (delay (constr 0 [])))))))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden index ae265e9a524..5e684e5e2c8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map2.uplc.golden @@ -1,259 +1,260 @@ -program - 1.1.0 - ((\fix1 -> - (\go -> - (\go -> - (\goList - n -> - (\unsafeFromList -> - (\nt -> - (\go -> - (\nt -> - (\nt -> - fix1 - (\go ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (constr 1 - [ (case - x - [ (\k v -> - constr 0 - [ k - , (decodeUtf8 - v) ]) ]) - , (go xs) ])) ])) - (go nt)) - ((\rs' -> - (\ls' -> go rs' ls') (go nt)) - (fix1 - (\go - xs -> - force - (force chooseList) - xs - (\ds -> []) - (\ds -> - (\hd -> - (\tl' -> - force - (case - ((\k -> - fix1 - (\go - xs -> - force - (force - chooseList) - xs - (\ds -> - constr 1 []) - (\ds -> - force - (force - (force - ifThenElse - (equalsData - k - (force - (force - fstPair) - (force - headList - xs))) - (delay - (delay - ((\ds -> - constr 0 - [ ]) - (force - tailList - xs)))) - (delay - (delay - (go - (force - tailList - xs))))))) - (constr 0 [])) - nt) - (force (force fstPair) - hd)) - [ (delay tl') - , (delay - (force mkCons - hd - tl')) ])) - (go (force tailList xs))) - (force headList xs)) - (constr 0 [])) - nt))) - (unsafeFromList - (\i -> iData i) - bData - (constr 1 - [ (constr 0 [(addInteger 1 n), #6f6e65]) +(program + 1.1.0 + ((\fix1 -> + (\go -> + (\go -> + (\goList + n -> + (\unsafeFromList -> + (\nt -> + (\go -> + (\nt -> + (\nt -> + fix1 + (\go ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (constr 1 + [ (case + x + [ (\k v -> + constr 0 + [ k + , (decodeUtf8 + v) ]) ]) + , (go xs) ])) ])) + (go nt)) + ((\rs' -> + (\ls' -> go rs' ls') (go nt)) + (fix1 + (\go + xs -> + force + (force chooseList) + xs + (\ds -> []) + (\ds -> + (\hd -> + (\tl' -> + force + (case + ((\k -> + fix1 + (\go + xs -> + force + (force + chooseList) + xs + (\ds -> + constr 1 + []) + (\ds -> + force + (force + (force + ifThenElse + (equalsData + k + (force + (force + fstPair) + (force + headList + xs))) + (delay + (delay + ((\ds -> + constr 0 + [ ]) + (force + tailList + xs)))) + (delay + (delay + (go + (force + tailList + xs))))))) + (constr 0 [])) + nt) + (force (force fstPair) + hd)) + [ (delay tl') + , (delay + (force mkCons + hd + tl')) ])) + (go (force tailList xs))) + (force headList xs)) + (constr 0 [])) + nt))) + (unsafeFromList + (\i -> iData i) + bData + (constr 1 + [ (constr 0 [(addInteger 1 n), #6f6e65]) + , (constr 1 + [ (constr 0 [(addInteger 2 n), #74776f]) + , (constr 1 + [ (constr 0 + [(addInteger 3 n), #7468726565]) + , (constr 1 + [ (constr 0 + [ (addInteger 4 n) + , #666f7572 ]) + , (constr 1 + [ (constr 0 + [ (addInteger 5 n) + , #66697665 ]) + , (constr 0 + []) ]) ]) ]) ]) ]))) + (fix1 + (\go + xs -> + force + (force chooseList) + xs + (\ds -> []) + (\ds -> + (\hd -> + (\tl -> + (\v' -> + (\k' -> + force + (case + (fix1 + (\go + xs -> + force + (force chooseList) + xs + (\ds -> constr 1 []) + (\ds -> + (\hd -> + force + (force + (force + ifThenElse + (equalsData + k' + (force + (force + fstPair) + hd)) + (delay + (delay + ((\ds -> + constr 0 + [ (force + (force + sndPair) + hd) ]) + (force + tailList + xs)))) + (delay + (delay + (go + (force + tailList + xs))))))) + (force headList + xs)) + (constr 0 [])) + nt) + [ (\r -> + delay + (force + mkCons + (mkPairData + k' + (bData + (appendByteString + (unBData + v') + (unBData + r)))) + (go tl))) + , (delay + (force mkCons + (mkPairData k' v') + (go tl))) ])) + (force (force fstPair) hd)) + (force (force sndPair) hd)) + (force tailList xs)) + (force headList xs)) + (constr 0 [])))) + (unsafeFromList + (\i -> iData i) + bData + (constr 1 + [ (constr 0 [(addInteger 3 n), #5448524545]) + , (constr 1 + [ (constr 0 [(addInteger 4 n), #464f5552]) , (constr 1 - [ (constr 0 [(addInteger 2 n), #74776f]) + [ (constr 0 [(addInteger 6 n), #534958]) , (constr 1 [ (constr 0 - [(addInteger 3 n), #7468726565]) - , (constr 1 - [ (constr 0 - [ (addInteger 4 n) - , #666f7572 ]) - , (constr 1 - [ (constr 0 - [ (addInteger 5 n) - , #66697665 ]) - , (constr 0 - []) ]) ]) ]) ]) ]))) + [(addInteger 7 n), #534556454e]) + , (constr 0 []) ]) ]) ]) ]))) + (\`$dToData` `$dToData` -> + (\go eta -> goList (go eta)) (fix1 - (\go - xs -> + (\go ds -> force - (force chooseList) - xs - (\ds -> []) - (\ds -> - (\hd -> - (\tl -> - (\v' -> - (\k' -> - force - (case - (fix1 - (\go - xs -> - force - (force chooseList) - xs - (\ds -> constr 1 []) - (\ds -> - (\hd -> - force - (force - (force - ifThenElse - (equalsData - k' - (force - (force - fstPair) - hd)) - (delay - (delay - ((\ds -> - constr 0 - [ (force - (force - sndPair) - hd) ]) - (force - tailList - xs)))) - (delay - (delay - (go - (force - tailList - xs))))))) - (force headList - xs)) - (constr 0 [])) - nt) - [ (\r -> - delay - (force - mkCons - (mkPairData - k' - (bData - (appendByteString - (unBData - v') - (unBData - r)))) - (go tl))) - , (delay - (force mkCons - (mkPairData k' v') - (go tl))) ])) - (force (force fstPair) hd)) - (force (force sndPair) hd)) - (force tailList xs)) - (force headList xs)) - (constr 0 [])))) - (unsafeFromList - (\i -> iData i) - bData - (constr 1 - [ (constr 0 [(addInteger 3 n), #5448524545]) - , (constr 1 - [ (constr 0 [(addInteger 4 n), #464f5552]) - , (constr 1 - [ (constr 0 [(addInteger 6 n), #534958]) - , (constr 1 - [ (constr 0 - [(addInteger 7 n), #534556454e]) - , (constr 0 []) ]) ]) ]) ]))) - (\`$dToData` `$dToData` -> - (\go eta -> goList (go eta)) - (fix1 - (\go ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (constr 1 - [ (case - x - [ (\k a -> - constr 0 - [ (`$dToData` k) - , (`$dToData` a) ]) ]) - , (go xs) ])) ]))))) - (fix1 - (\goList ds -> - force - (case - ds - [ (delay []) - , (\d ds -> - delay - (force mkCons - (case d [(\d d -> mkPairData d d)]) - (goList ds))) ])))) - (fix1 - (\go acc xs -> - force (force chooseList) - xs - (\ds -> acc) - (\ds -> - go - (force mkCons (force headList xs) acc) - (force tailList xs)) - (constr 0 [])))) - (fix1 - (\go xs -> - force (force chooseList) - xs - (\ds -> constr 0 []) - (\ds -> - (\hd -> - (\tl -> - constr 1 - [ (constr 0 - [ (unIData (force (force fstPair) hd)) - , (unBData (force (force sndPair) hd)) ]) - , (go tl) ]) - (force tailList xs)) - (force headList xs)) - (constr 0 [])))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (constr 1 + [ (case + x + [ (\k a -> + constr 0 + [ (`$dToData` k) + , (`$dToData` a) ]) ]) + , (go xs) ])) ]))))) + (fix1 + (\goList ds -> + force + (case + ds + [ (delay []) + , (\d ds -> + delay + (force mkCons + (case d [(\d d -> mkPairData d d)]) + (goList ds))) ])))) + (fix1 + (\go acc xs -> + force (force chooseList) + xs + (\ds -> acc) + (\ds -> + go + (force mkCons (force headList xs) acc) + (force tailList xs)) + (constr 0 [])))) + (fix1 + (\go xs -> + force (force chooseList) + xs + (\ds -> constr 0 []) + (\ds -> + (\hd -> + (\tl -> + constr 1 + [ (constr 0 + [ (unIData (force (force fstPair) hd)) + , (unBData (force (force sndPair) hd)) ]) + , (go tl) ]) + (force tailList xs)) + (force headList xs)) + (constr 0 [])))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden index ae265e9a524..5e684e5e2c8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/map3.uplc.golden @@ -1,259 +1,260 @@ -program - 1.1.0 - ((\fix1 -> - (\go -> - (\go -> - (\goList - n -> - (\unsafeFromList -> - (\nt -> - (\go -> - (\nt -> - (\nt -> - fix1 - (\go ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (constr 1 - [ (case - x - [ (\k v -> - constr 0 - [ k - , (decodeUtf8 - v) ]) ]) - , (go xs) ])) ])) - (go nt)) - ((\rs' -> - (\ls' -> go rs' ls') (go nt)) - (fix1 - (\go - xs -> - force - (force chooseList) - xs - (\ds -> []) - (\ds -> - (\hd -> - (\tl' -> - force - (case - ((\k -> - fix1 - (\go - xs -> - force - (force - chooseList) - xs - (\ds -> - constr 1 []) - (\ds -> - force - (force - (force - ifThenElse - (equalsData - k - (force - (force - fstPair) - (force - headList - xs))) - (delay - (delay - ((\ds -> - constr 0 - [ ]) - (force - tailList - xs)))) - (delay - (delay - (go - (force - tailList - xs))))))) - (constr 0 [])) - nt) - (force (force fstPair) - hd)) - [ (delay tl') - , (delay - (force mkCons - hd - tl')) ])) - (go (force tailList xs))) - (force headList xs)) - (constr 0 [])) - nt))) - (unsafeFromList - (\i -> iData i) - bData - (constr 1 - [ (constr 0 [(addInteger 1 n), #6f6e65]) +(program + 1.1.0 + ((\fix1 -> + (\go -> + (\go -> + (\goList + n -> + (\unsafeFromList -> + (\nt -> + (\go -> + (\nt -> + (\nt -> + fix1 + (\go ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (constr 1 + [ (case + x + [ (\k v -> + constr 0 + [ k + , (decodeUtf8 + v) ]) ]) + , (go xs) ])) ])) + (go nt)) + ((\rs' -> + (\ls' -> go rs' ls') (go nt)) + (fix1 + (\go + xs -> + force + (force chooseList) + xs + (\ds -> []) + (\ds -> + (\hd -> + (\tl' -> + force + (case + ((\k -> + fix1 + (\go + xs -> + force + (force + chooseList) + xs + (\ds -> + constr 1 + []) + (\ds -> + force + (force + (force + ifThenElse + (equalsData + k + (force + (force + fstPair) + (force + headList + xs))) + (delay + (delay + ((\ds -> + constr 0 + [ ]) + (force + tailList + xs)))) + (delay + (delay + (go + (force + tailList + xs))))))) + (constr 0 [])) + nt) + (force (force fstPair) + hd)) + [ (delay tl') + , (delay + (force mkCons + hd + tl')) ])) + (go (force tailList xs))) + (force headList xs)) + (constr 0 [])) + nt))) + (unsafeFromList + (\i -> iData i) + bData + (constr 1 + [ (constr 0 [(addInteger 1 n), #6f6e65]) + , (constr 1 + [ (constr 0 [(addInteger 2 n), #74776f]) + , (constr 1 + [ (constr 0 + [(addInteger 3 n), #7468726565]) + , (constr 1 + [ (constr 0 + [ (addInteger 4 n) + , #666f7572 ]) + , (constr 1 + [ (constr 0 + [ (addInteger 5 n) + , #66697665 ]) + , (constr 0 + []) ]) ]) ]) ]) ]))) + (fix1 + (\go + xs -> + force + (force chooseList) + xs + (\ds -> []) + (\ds -> + (\hd -> + (\tl -> + (\v' -> + (\k' -> + force + (case + (fix1 + (\go + xs -> + force + (force chooseList) + xs + (\ds -> constr 1 []) + (\ds -> + (\hd -> + force + (force + (force + ifThenElse + (equalsData + k' + (force + (force + fstPair) + hd)) + (delay + (delay + ((\ds -> + constr 0 + [ (force + (force + sndPair) + hd) ]) + (force + tailList + xs)))) + (delay + (delay + (go + (force + tailList + xs))))))) + (force headList + xs)) + (constr 0 [])) + nt) + [ (\r -> + delay + (force + mkCons + (mkPairData + k' + (bData + (appendByteString + (unBData + v') + (unBData + r)))) + (go tl))) + , (delay + (force mkCons + (mkPairData k' v') + (go tl))) ])) + (force (force fstPair) hd)) + (force (force sndPair) hd)) + (force tailList xs)) + (force headList xs)) + (constr 0 [])))) + (unsafeFromList + (\i -> iData i) + bData + (constr 1 + [ (constr 0 [(addInteger 3 n), #5448524545]) + , (constr 1 + [ (constr 0 [(addInteger 4 n), #464f5552]) , (constr 1 - [ (constr 0 [(addInteger 2 n), #74776f]) + [ (constr 0 [(addInteger 6 n), #534958]) , (constr 1 [ (constr 0 - [(addInteger 3 n), #7468726565]) - , (constr 1 - [ (constr 0 - [ (addInteger 4 n) - , #666f7572 ]) - , (constr 1 - [ (constr 0 - [ (addInteger 5 n) - , #66697665 ]) - , (constr 0 - []) ]) ]) ]) ]) ]))) + [(addInteger 7 n), #534556454e]) + , (constr 0 []) ]) ]) ]) ]))) + (\`$dToData` `$dToData` -> + (\go eta -> goList (go eta)) (fix1 - (\go - xs -> + (\go ds -> force - (force chooseList) - xs - (\ds -> []) - (\ds -> - (\hd -> - (\tl -> - (\v' -> - (\k' -> - force - (case - (fix1 - (\go - xs -> - force - (force chooseList) - xs - (\ds -> constr 1 []) - (\ds -> - (\hd -> - force - (force - (force - ifThenElse - (equalsData - k' - (force - (force - fstPair) - hd)) - (delay - (delay - ((\ds -> - constr 0 - [ (force - (force - sndPair) - hd) ]) - (force - tailList - xs)))) - (delay - (delay - (go - (force - tailList - xs))))))) - (force headList - xs)) - (constr 0 [])) - nt) - [ (\r -> - delay - (force - mkCons - (mkPairData - k' - (bData - (appendByteString - (unBData - v') - (unBData - r)))) - (go tl))) - , (delay - (force mkCons - (mkPairData k' v') - (go tl))) ])) - (force (force fstPair) hd)) - (force (force sndPair) hd)) - (force tailList xs)) - (force headList xs)) - (constr 0 [])))) - (unsafeFromList - (\i -> iData i) - bData - (constr 1 - [ (constr 0 [(addInteger 3 n), #5448524545]) - , (constr 1 - [ (constr 0 [(addInteger 4 n), #464f5552]) - , (constr 1 - [ (constr 0 [(addInteger 6 n), #534958]) - , (constr 1 - [ (constr 0 - [(addInteger 7 n), #534556454e]) - , (constr 0 []) ]) ]) ]) ]))) - (\`$dToData` `$dToData` -> - (\go eta -> goList (go eta)) - (fix1 - (\go ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (constr 1 - [ (case - x - [ (\k a -> - constr 0 - [ (`$dToData` k) - , (`$dToData` a) ]) ]) - , (go xs) ])) ]))))) - (fix1 - (\goList ds -> - force - (case - ds - [ (delay []) - , (\d ds -> - delay - (force mkCons - (case d [(\d d -> mkPairData d d)]) - (goList ds))) ])))) - (fix1 - (\go acc xs -> - force (force chooseList) - xs - (\ds -> acc) - (\ds -> - go - (force mkCons (force headList xs) acc) - (force tailList xs)) - (constr 0 [])))) - (fix1 - (\go xs -> - force (force chooseList) - xs - (\ds -> constr 0 []) - (\ds -> - (\hd -> - (\tl -> - constr 1 - [ (constr 0 - [ (unIData (force (force fstPair) hd)) - , (unBData (force (force sndPair) hd)) ]) - , (go tl) ]) - (force tailList xs)) - (force headList xs)) - (constr 0 [])))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (constr 1 + [ (case + x + [ (\k a -> + constr 0 + [ (`$dToData` k) + , (`$dToData` a) ]) ]) + , (go xs) ])) ]))))) + (fix1 + (\goList ds -> + force + (case + ds + [ (delay []) + , (\d ds -> + delay + (force mkCons + (case d [(\d d -> mkPairData d d)]) + (goList ds))) ])))) + (fix1 + (\go acc xs -> + force (force chooseList) + xs + (\ds -> acc) + (\ds -> + go + (force mkCons (force headList xs) acc) + (force tailList xs)) + (constr 0 [])))) + (fix1 + (\go xs -> + force (force chooseList) + xs + (\ds -> constr 0 []) + (\ds -> + (\hd -> + (\tl -> + constr 1 + [ (constr 0 + [ (unIData (force (force fstPair) hd)) + , (unBData (force (force sndPair) hd)) ]) + , (go tl) ]) + (force tailList xs)) + (force headList xs)) + (constr 0 [])))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/monadicDo.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/monadicDo.uplc.golden index f9c81874ea3..de611eedb67 100644 --- a/plutus-tx-plugin/test/Budget/9.6/monadicDo.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/monadicDo.uplc.golden @@ -1,10 +1,10 @@ -program - 1.1.0 - ((\`$fMonadMaybe_$c>>=` -> - `$fMonadMaybe_$c>>=` - (constr 0 [1]) - (\x' -> - `$fMonadMaybe_$c>>=` - (constr 0 [2]) - (\y' -> constr 0 [(addInteger x' y')]))) - (\ds k -> force (case ds [(\x -> delay (k x)), (delay (constr 1 []))]))) \ No newline at end of file +(program + 1.1.0 + ((\`$fMonadMaybe_$c>>=` -> + `$fMonadMaybe_$c>>=` + (constr 0 [1]) + (\x' -> + `$fMonadMaybe_$c>>=` + (constr 0 [2]) + (\y' -> constr 0 [(addInteger x' y')]))) + (\ds k -> force (case ds [(\x -> delay (k x)), (delay (constr 1 []))])))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden index 46058709e9e..dc4df8a3ab5 100644 --- a/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/not-not.uplc.golden @@ -1,13 +1,13 @@ -program - 1.1.0 - ((\x -> - force - (case - (force - (force - (force ifThenElse - (lessThanInteger 0 x) - (delay (delay (constr 1 []))) - (delay (delay (constr 0 [])))))) - [(delay (constr 1 [])), (delay (constr 0 []))])) - 1) \ No newline at end of file +(program + 1.1.0 + ((\x -> + force + (case + (force + (force + (force ifThenElse + (lessThanInteger 0 x) + (delay (delay (constr 1 []))) + (delay (delay (constr 0 [])))))) + [(delay (constr 1 [])), (delay (constr 0 []))])) + 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden index b7d98ed22ec..db9fda02a2b 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemCheap.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (equalsInteger 1 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (equalsInteger 1 x) + (delay (delay (constr 1 []))) + (delay (delay (s s xs))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden index 144f2805e80..05dd8338af8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/notElemExpensive.uplc.golden @@ -1,39 +1,39 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay (delay (constr 1 []))) - (delay (delay (s s xs))))))) ])) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (force + (force ifThenElse + (equalsInteger 0 x) + (delay (delay (constr 1 []))) + (delay (delay (s s xs))))))) ])) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/null.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/null.uplc.golden index 82ae7e6d845..8cea17095f8 100644 --- a/plutus-tx-plugin/test/Budget/9.6/null.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/null.uplc.golden @@ -1 +1 @@ -program 1.1.0 (constr 1 []) \ No newline at end of file +(program 1.1.0 (constr 1 [])) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/orCheap.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/orCheap.uplc.golden index 07f7cdbe6c6..22714ff32ac 100644 --- a/plutus-tx-plugin/test/Budget/9.6/orCheap.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/orCheap.uplc.golden @@ -1,35 +1,35 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (case x [(delay (constr 0 [])), (delay (s s xs))]))) ])) - (constr 1 - [ (constr 0 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (case x [(delay (constr 0 [])), (delay (s s xs))]))) ])) + (constr 1 + [ (constr 0 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/orExpensive.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/orExpensive.uplc.golden index 999d48fa89a..12afb874897 100644 --- a/plutus-tx-plugin/test/Budget/9.6/orExpensive.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/orExpensive.uplc.golden @@ -1,35 +1,35 @@ -program - 1.1.0 - ((\s -> - s s) - (\s ds -> - force - (case - ds - [ (delay (constr 1 [])) - , (\x xs -> - delay - (force - (case x [(delay (constr 0 [])), (delay (s s xs))]))) ])) - (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 1 - [ (constr 1 []) - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) \ No newline at end of file +(program + 1.1.0 + ((\s -> + s s) + (\s ds -> + force + (case + ds + [ (delay (constr 1 [])) + , (\x xs -> + delay + (force + (case x [(delay (constr 0 [])), (delay (s s xs))]))) ])) + (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 1 + [ (constr 1 []) + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/patternMatch.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/patternMatch.uplc.golden index eff0c489f34..2636cbd763d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/patternMatch.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/patternMatch.uplc.golden @@ -1 +1 @@ -program 1.1.0 (constr 0 [3]) \ No newline at end of file +(program 1.1.0 (constr 0 [3])) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden index 4d7f2200920..dfe8b48b92d 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveGte0.uplc.golden @@ -1,45 +1,46 @@ -program - 1.1.0 - ((\fix1 -> - (\go -> - (\recursiveAll -> - (\ls -> - force recursiveAll - (\v -> - force ifThenElse - (lessThanInteger v 0) - (constr 1 []) - (constr 0 [])) - ls) - (go 1000)) - (fix1 - (\recursiveAll arg -> - delay - (\ds ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (case - (ds x) - [ (delay - (force - (recursiveAll (delay (\x -> x))) - ds - xs)) - , (delay (constr 1 [])) ]))) ]))) - (delay (\x -> x)))) - (fix1 - (\go n -> - force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 [0, (go (subtractInteger n 1))])))))))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + (\go -> + (\recursiveAll -> + (\ls -> + force recursiveAll + (\v -> + force ifThenElse + (lessThanInteger v 0) + (constr 1 []) + (constr 0 [])) + ls) + (go 1000)) + (fix1 + (\recursiveAll arg -> + delay + (\ds ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (case + (ds x) + [ (delay + (force + (recursiveAll + (delay (\x -> x))) + ds + xs)) + , (delay (constr 1 [])) ]))) ]))) + (delay (\x -> x)))) + (fix1 + (\go n -> + force + (force + (force ifThenElse + (lessThanEqualsInteger n 0) + (delay (delay (constr 0 []))) + (delay + (delay + (constr 1 [0, (go (subtractInteger n 1))])))))))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden index fe1355dc3c9..97d380b65ff 100644 --- a/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/recursiveLte0.uplc.golden @@ -1,45 +1,46 @@ -program - 1.1.0 - ((\fix1 -> - (\go -> - (\recursiveAll -> - (\ls -> - force recursiveAll - (\v -> - force ifThenElse - (lessThanEqualsInteger v 0) - (constr 0 []) - (constr 1 [])) - ls) - (go 1000)) - (fix1 - (\recursiveAll arg -> - delay - (\ds ds -> - force - (case - ds - [ (delay (constr 0 [])) - , (\x xs -> - delay - (force - (case - (ds x) - [ (delay - (force - (recursiveAll (delay (\x -> x))) - ds - xs)) - , (delay (constr 1 [])) ]))) ]))) - (delay (\x -> x)))) - (fix1 - (\go n -> - force - (force - (force ifThenElse - (lessThanEqualsInteger n 0) - (delay (delay (constr 0 []))) - (delay - (delay - (constr 1 [0, (go (subtractInteger n 1))])))))))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + (\go -> + (\recursiveAll -> + (\ls -> + force recursiveAll + (\v -> + force ifThenElse + (lessThanEqualsInteger v 0) + (constr 0 []) + (constr 1 [])) + ls) + (go 1000)) + (fix1 + (\recursiveAll arg -> + delay + (\ds ds -> + force + (case + ds + [ (delay (constr 0 [])) + , (\x xs -> + delay + (force + (case + (ds x) + [ (delay + (force + (recursiveAll + (delay (\x -> x))) + ds + xs)) + , (delay (constr 1 [])) ]))) ]))) + (delay (\x -> x)))) + (fix1 + (\go n -> + force + (force + (force ifThenElse + (lessThanEqualsInteger n 0) + (delay (delay (constr 0 []))) + (delay + (delay + (constr 1 [0, (go (subtractInteger n 1))])))))))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden index a9d98085741..ef9ba5eb081 100644 --- a/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/show.uplc.golden @@ -1,506 +1,510 @@ -program - 1.1.0 - ((\fix1 -> - (\go -> - (\go -> - (\`$fShowBuiltinByteString_$cshowsPrec` -> - (\toHex -> - (\go -> - (\`$fEnumBool_$cenumFromTo` -> - (\go -> - (\go -> - (\concatBuiltinStrings -> - (\a -> - (\c -> - (\d -> - (\cse -> - (\e -> - (\cse -> - multiplyInteger - 2 - (force - trace - (concatBuiltinStrings - (constr 1 - [ "(" - , (cse - (constr 1 - [ "," - , (cse - (constr 1 - [ "," - , (cse - c - (constr 1 - [ "," - , (cse - d - (constr 1 - [ "," - , (cse - e - (constr 1 - [ ")" - , (constr 0 - [ ]) ])) ])) ])) ])) ])) ])) - e)) - (cse a)) - (force - trace - (concatBuiltinStrings - ((\go -> - constr 1 - [ "[" - , (cse - a - (go - (constr 1 - [ a - , (constr 1 - [ c - , (constr 1 - [ d - , (constr 0 - [ ]) ]) ]) ]) - (constr 1 - [ "]" - , (constr 0 - [ ]) ]))) ]) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay - (\x -> - x)) - , (\x - xs -> - delay - ((\acc - eta -> - constr 1 - [ "," - , (cse - x - (acc - eta)) ]) - (go - xs))) ]))))) - d)) - (`$fShowBuiltinByteString_$cshowsPrec` - 0)) - (force trace - (force - (force ifThenElse - (lessThanEqualsInteger c 0) - (delay "False") - (delay "True"))) - c)) - (force trace - (concatBuiltinStrings - (go - (`$fEnumBool_$cenumFromTo` 0 17) - (constr 0 []))) - a)) - (force - trace - ((\x -> - concatBuiltinStrings - (`$fShowBuiltinByteString_$cshowsPrec` - 0 - x - (constr 0 []))) - -1234567890) - -1234567890)) - (fix1 - (\concatBuiltinStrings - ds -> - case - ds - [ "" - , (\x - ds -> - force - (case - ds - [ (delay x) - , (\ipv - ipv -> - delay - (case - ((\n -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger - n - 0) - (delay - (delay - (constr 0 - [ (constr 0 - [ ]) - , ds ]))) - (delay - (delay - (force - go - n - ds)))))) - (divideInteger - (go ds) - 2)) - [ (\ipv - ipv -> - appendString - (concatBuiltinStrings - ipv) - (concatBuiltinStrings - ipv)) ])) ])) ]))) - (fix1 - (\go ds -> - force - (case - ds - [ (delay 0) - , (\x xs -> - delay (addInteger 1 (go xs))) ])))) - (fix1 - (\go - arg -> - delay - (\ds - ds -> - force - (case - ds - [ (delay - (constr 0 - [ (constr 0 []) - , (constr 0 []) ])) - , (\y - ys -> - delay - (force - (force - (force - ifThenElse - (equalsInteger 1 ds) - (delay - (delay - (constr 0 - [ (constr 1 - [ y - , (constr 0 - [ ]) ]) - , ys ]))) - (delay - (delay - (case - (force - (go - (delay - (\x -> - x))) - (subtractInteger - ds - 1) - ys) - [ (\zs - ws -> - constr 0 - [ (constr 1 - [ y - , zs ]) - , ws ]) ]))))))) ]))) - (delay (\x -> x)))) - (fix1 - (\`$fEnumBool_$cenumFromTo` x lim -> - force - (force - (force ifThenElse - (lessThanEqualsInteger x lim) - (delay - (delay - (constr 1 - [ x - , (`$fEnumBool_$cenumFromTo` - (addInteger 1 x) - lim) ]))) - (delay (delay (constr 0 [])))))))) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay (\x -> x)) - , (\x - xs -> - delay - ((\acc - eta -> - (\x eta -> - toHex - (divideInteger x 16) - (toHex (modInteger x 16) eta)) - (indexByteString - #5468697320697320616e206578616d706c65 - x) - (acc eta)) - (go xs))) ])))) - (\x -> - force - (force - (force - ifThenElse - (lessThanEqualsInteger x 9) - (delay - (delay - (`$fShowBuiltinByteString_$cshowsPrec` 0 x))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 10 x) - (delay - (delay - (\ds -> constr 1 ["a", ds]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 11 x) - (delay - (delay - (\ds -> - constr 1 - [ "b" - , ds ]))) - (delay - (delay - (force +(program + 1.1.0 + ((\fix1 -> + (\go -> + (\go -> + (\`$fShowBuiltinByteString_$cshowsPrec` -> + (\toHex -> + (\go -> + (\`$fEnumBool_$cenumFromTo` -> + (\go -> + (\go -> + (\concatBuiltinStrings -> + (\a -> + (\c -> + (\d -> + (\cse -> + (\e -> + (\cse -> + multiplyInteger + 2 + (force + trace + (concatBuiltinStrings + (constr 1 + [ "(" + , (cse + (constr 1 + [ "," + , (cse + (constr 1 + [ "," + , (cse + c + (constr 1 + [ "," + , (cse + d + (constr 1 + [ "," + , (cse + e + (constr 1 + [ ")" + , (constr 0 + [ ]) ])) ])) ])) ])) ])) ])) + e)) + (cse a)) + (force + trace + (concatBuiltinStrings + ((\go -> + constr 1 + [ "[" + , (cse + a + (go + (constr 1 + [ a + , (constr 1 + [ c + , (constr 1 + [ d + , (constr 0 + [ ]) ]) ]) ]) + (constr 1 + [ "]" + , (constr 0 + [ ]) ]))) ]) + (fix1 + (\go + ds -> + force + (case + ds + [ (delay + (\x -> + x)) + , (\x + xs -> + delay + ((\acc + eta -> + constr 1 + [ "," + , (cse + x + (acc + eta)) ]) + (go + xs))) ]))))) + d)) + (`$fShowBuiltinByteString_$cshowsPrec` + 0)) + (force trace + (force + (force ifThenElse + (lessThanEqualsInteger c 0) + (delay "False") + (delay "True"))) + c)) + (force trace + (concatBuiltinStrings + (go + (`$fEnumBool_$cenumFromTo` 0 17) + (constr 0 []))) + a)) + (force + trace + ((\x -> + concatBuiltinStrings + (`$fShowBuiltinByteString_$cshowsPrec` + 0 + x + (constr 0 []))) + -1234567890) + -1234567890)) + (fix1 + (\concatBuiltinStrings + ds -> + case + ds + [ "" + , (\x + ds -> + force + (case + ds + [ (delay x) + , (\ipv + ipv -> + delay + (case + ((\n -> + force (force (force ifThenElse - (equalsInteger - 12 - x) + (lessThanEqualsInteger + n + 0) (delay (delay - (\ds -> - constr 1 - [ "c" - , ds ]))) + (constr 0 + [ (constr 0 + [ ]) + , ds ]))) (delay (delay (force - (force - (force - ifThenElse - (equalsInteger - 13 - x) - (delay - (delay - (\ds -> - constr 1 - [ "d" - , ds ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 14 - x) - (delay - (delay - (\ds -> - constr 1 - [ "e" - , ds ]))) - (delay - (delay - (force - (force - ifThenElse - (equalsInteger - 15 - x) - (delay - (\ds -> - constr 1 - [ "f" - , ds ])) - (delay - (\ds -> - constr 1 - [ "" - , ds ]))))))))))))))))))))))))))))))))))) - (fix1 - (\`$fShowBuiltinByteString_$cshowsPrec` p n -> - force - (force - (force ifThenElse - (lessThanInteger n 0) - (delay - (delay - (\eta -> - constr 1 - [ "-" - , (`$fShowBuiltinByteString_$cshowsPrec` - p - (subtractInteger 0 n) - eta) ]))) - (delay (delay (go (go (constr 0 []) n))))))))) - (fix1 - (\go - ds -> - force - (case - ds - [ (delay (\x -> x)) - , (\x - xs -> - delay - ((\acc - eta -> - constr 1 - [ (force - (force - (force - ifThenElse - (equalsInteger 0 x) - (delay (delay "0")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 1 x) - (delay (delay "1")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 2 - x) - (delay - (delay - "2")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 3 - x) - (delay - (delay - "3")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 4 - x) - (delay - (delay - "4")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 5 - x) - (delay - (delay - "5")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 6 - x) - (delay - (delay - "6")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 7 - x) - (delay - (delay - "7")) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 8 - x) - (delay - (delay - "8")) - (delay - (delay - (force - (force - ifThenElse - (equalsInteger - 9 - x) - (delay - "9") - (delay - "")))))))))))))))))))))))))))))))))))))))))))))))) - , (acc eta) ]) - (go xs))) ])))) - (fix1 - (\go acc n -> - (\x -> - force - (force - (force ifThenElse - (equalsInteger 0 x) - (delay - (delay (constr 1 [(remainderInteger n 10), acc]))) - (delay - (delay - (go - (constr 1 [(remainderInteger n 10), acc]) - x)))))) - (quotientInteger n 10)))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file + go + n + ds)))))) + (divideInteger + (go ds) + 2)) + [ (\ipv + ipv -> + appendString + (concatBuiltinStrings + ipv) + (concatBuiltinStrings + ipv)) ])) ])) ]))) + (fix1 + (\go ds -> + force + (case + ds + [ (delay 0) + , (\x xs -> + delay + (addInteger 1 (go xs))) ])))) + (fix1 + (\go + arg -> + delay + (\ds + ds -> + force + (case + ds + [ (delay + (constr 0 + [ (constr 0 []) + , (constr 0 []) ])) + , (\y + ys -> + delay + (force + (force + (force + ifThenElse + (equalsInteger 1 ds) + (delay + (delay + (constr 0 + [ (constr 1 + [ y + , (constr 0 + [ ]) ]) + , ys ]))) + (delay + (delay + (case + (force + (go + (delay + (\x -> + x))) + (subtractInteger + ds + 1) + ys) + [ (\zs + ws -> + constr 0 + [ (constr 1 + [ y + , zs ]) + , ws ]) ]))))))) ]))) + (delay (\x -> x)))) + (fix1 + (\`$fEnumBool_$cenumFromTo` x lim -> + force + (force + (force ifThenElse + (lessThanEqualsInteger x lim) + (delay + (delay + (constr 1 + [ x + , (`$fEnumBool_$cenumFromTo` + (addInteger 1 x) + lim) ]))) + (delay (delay (constr 0 [])))))))) + (fix1 + (\go + ds -> + force + (case + ds + [ (delay (\x -> x)) + , (\x + xs -> + delay + ((\acc + eta -> + (\x eta -> + toHex + (divideInteger x 16) + (toHex (modInteger x 16) eta)) + (indexByteString + #5468697320697320616e206578616d706c65 + x) + (acc eta)) + (go xs))) ])))) + (\x -> + force + (force + (force + ifThenElse + (lessThanEqualsInteger x 9) + (delay + (delay + (`$fShowBuiltinByteString_$cshowsPrec` 0 x))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger 10 x) + (delay + (delay + (\ds -> constr 1 ["a", ds]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger 11 x) + (delay + (delay + (\ds -> + constr 1 + [ "b" + , ds ]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 12 + x) + (delay + (delay + (\ds -> + constr 1 + [ "c" + , ds ]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 13 + x) + (delay + (delay + (\ds -> + constr 1 + [ "d" + , ds ]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 14 + x) + (delay + (delay + (\ds -> + constr 1 + [ "e" + , ds ]))) + (delay + (delay + (force + (force + ifThenElse + (equalsInteger + 15 + x) + (delay + (\ds -> + constr 1 + [ "f" + , ds ])) + (delay + (\ds -> + constr 1 + [ "" + , ds ]))))))))))))))))))))))))))))))))))) + (fix1 + (\`$fShowBuiltinByteString_$cshowsPrec` p n -> + force + (force + (force ifThenElse + (lessThanInteger n 0) + (delay + (delay + (\eta -> + constr 1 + [ "-" + , (`$fShowBuiltinByteString_$cshowsPrec` + p + (subtractInteger 0 n) + eta) ]))) + (delay (delay (go (go (constr 0 []) n))))))))) + (fix1 + (\go + ds -> + force + (case + ds + [ (delay (\x -> x)) + , (\x + xs -> + delay + ((\acc + eta -> + constr 1 + [ (force + (force + (force + ifThenElse + (equalsInteger 0 x) + (delay (delay "0")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 1 + x) + (delay + (delay "1")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 2 + x) + (delay + (delay + "2")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 3 + x) + (delay + (delay + "3")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 4 + x) + (delay + (delay + "4")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 5 + x) + (delay + (delay + "5")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 6 + x) + (delay + (delay + "6")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 7 + x) + (delay + (delay + "7")) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 8 + x) + (delay + (delay + "8")) + (delay + (delay + (force + (force + ifThenElse + (equalsInteger + 9 + x) + (delay + "9") + (delay + "")))))))))))))))))))))))))))))))))))))))))))))))) + , (acc eta) ]) + (go xs))) ])))) + (fix1 + (\go acc n -> + (\x -> + force + (force + (force ifThenElse + (equalsInteger 0 x) + (delay + (delay (constr 1 [(remainderInteger n 10), acc]))) + (delay + (delay + (go + (constr 1 [(remainderInteger n 10), acc]) + x)))))) + (quotientInteger n 10)))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sum.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sum.uplc.golden index 22d067a2473..b7b1aaf24e0 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sum.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sum.uplc.golden @@ -1,35 +1,35 @@ -program - 1.1.0 - ((\`$dAdditiveMonoid` -> - (\f -> - (\z -> - (\go eta -> go eta) - ((\s -> s s) - (\s ds -> - force - (case ds [(delay z), (\x xs -> delay (f x (s s xs)))])))) - (case `$dAdditiveMonoid` [(\v v -> v)])) - (case `$dAdditiveMonoid` [(\v v -> v)]) - (constr 1 - [ 1 - , (constr 1 - [ 2 - , (constr 1 - [ 3 - , (constr 1 - [ 4 - , (constr 1 - [ 5 - , (constr 1 - [ 6 - , (constr 1 - [ 7 - , (constr 1 - [ 8 - , (constr 1 - [ 9 - , (constr 1 - [ 10 - , (constr 0 - [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) - (constr 0 [(\x y -> addInteger x y), 0])) \ No newline at end of file +(program + 1.1.0 + ((\`$dAdditiveMonoid` -> + (\f -> + (\z -> + (\go eta -> go eta) + ((\s -> s s) + (\s ds -> + force + (case ds [(delay z), (\x xs -> delay (f x (s s xs)))])))) + (case `$dAdditiveMonoid` [(\v v -> v)])) + (case `$dAdditiveMonoid` [(\v v -> v)]) + (constr 1 + [ 1 + , (constr 1 + [ 2 + , (constr 1 + [ 3 + , (constr 1 + [ 4 + , (constr 1 + [ 5 + , (constr 1 + [ 6 + , (constr 1 + [ 7 + , (constr 1 + [ 8 + , (constr 1 + [ 9 + , (constr 1 + [ 10 + , (constr 0 + [ ]) ]) ]) ]) ]) ]) ]) ]) ]) ]) ])) + (constr 0 [(\x y -> addInteger x y), 0]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden index 1aef25628e9..ac95726d0d2 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumL.uplc.golden @@ -1,29 +1,29 @@ -program - 1.1.0 - ((\fix1 -> - (\go -> - (\ls -> go 0 ls) - (fix1 - (\`$fEnumBool_$cenumFromTo` x lim -> - force - (force - (force ifThenElse - (lessThanEqualsInteger x lim) - (delay - (delay - (constr 1 - [ x - , (`$fEnumBool_$cenumFromTo` - (addInteger 1 x) - lim) ]))) - (delay (delay (constr 0 [])))))) - 1 - 1000)) - (fix1 - (\go acc ds -> - force - (case - ds - [ (delay acc) - , (\x xs -> delay (go (addInteger acc x) xs)) ])))) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + (\go -> + (\ls -> go 0 ls) + (fix1 + (\`$fEnumBool_$cenumFromTo` x lim -> + force + (force + (force ifThenElse + (lessThanEqualsInteger x lim) + (delay + (delay + (constr 1 + [ x + , (`$fEnumBool_$cenumFromTo` + (addInteger 1 x) + lim) ]))) + (delay (delay (constr 0 [])))))) + 1 + 1000)) + (fix1 + (\go acc ds -> + force + (case + ds + [ (delay acc) + , (\x xs -> delay (go (addInteger acc x) xs)) ])))) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden index 3d0f5cca946..ba7ce15ffce 100644 --- a/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/sumR.uplc.golden @@ -1,23 +1,24 @@ -program - 1.1.0 - ((\fix1 -> - fix1 - (\go ds -> - force (case ds [(delay 0), (\x xs -> delay (addInteger x (go xs)))])) - (fix1 - (\`$fEnumBool_$cenumFromTo` x lim -> - force - (force - (force ifThenElse - (lessThanEqualsInteger x lim) - (delay - (delay - (constr 1 - [ x - , (`$fEnumBool_$cenumFromTo` - (addInteger 1 x) - lim) ]))) - (delay (delay (constr 0 [])))))) - 1 - 1000)) - (\f -> (\s -> s s) (\s -> f (\x -> s s x)))) \ No newline at end of file +(program + 1.1.0 + ((\fix1 -> + fix1 + (\go ds -> + force + (case ds [(delay 0), (\x xs -> delay (addInteger x (go xs)))])) + (fix1 + (\`$fEnumBool_$cenumFromTo` x lim -> + force + (force + (force ifThenElse + (lessThanEqualsInteger x lim) + (delay + (delay + (constr 1 + [ x + , (`$fEnumBool_$cenumFromTo` + (addInteger 1 x) + lim) ]))) + (delay (delay (constr 0 [])))))) + 1 + 1000)) + (\f -> (\s -> s s) (\s -> f (\x -> s s x))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden b/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden index d061dbd6457..2e9f7662ae1 100644 --- a/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden +++ b/plutus-tx-plugin/test/Budget/9.6/toFromData.uplc.golden @@ -1,205 +1,207 @@ -program - 1.1.0 - ((\traceError -> - (\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger 0 index) - (delay - (delay (constr 0 [(unIData (force headList args))]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger 1 index) - (delay - (delay - (constr 1 - [ ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - ((\l -> - constr 0 - [ ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 0 - [ ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) - , (unIData - (force - headList - l)) - , ((\tup -> - (\index -> - (\args -> - force - (force - (force - ifThenElse - (equalsInteger - 0 - index) - (delay - (delay - (constr 1 - [ ]))) - (delay - (delay - (force - (force - (force - ifThenElse - (equalsInteger - 1 - index) - (delay - (delay - (constr 0 - [ ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - (force - tailList - l)))) ]) - (force - tailList - args)))) - (delay - (delay - (traceError - "PT1")))))) - (force - (force - sndPair) - tup)) - (force - (force - fstPair) - tup)) - (unConstrData - (force - headList - args))) ]))) - (delay - (delay - (traceError - "PT1"))))))))))) - (force (force sndPair) - tup)) - (force (force fstPair) - tup)) - (unConstrData - (force headList - args))) ]))) - (delay (delay (traceError "PT1"))))))))))) - (force (force sndPair) tup)) - (force (force fstPair) tup)) - (unConstrData - (constrData - 1 - (force mkCons - (constrData - 0 - (force mkCons - (constrData - 0 - (force mkCons - (Constr 1 []) - (force mkCons - (iData 1) - (force mkCons (Constr 0 []) [])))) - [])) - [])))) - (\str -> (\x -> error) (force trace str (constr 0 [])))) \ No newline at end of file +(program + 1.1.0 + ((\traceError -> + (\tup -> + (\index -> + (\args -> + force + (force + (force + ifThenElse + (equalsInteger 0 index) + (delay + (delay (constr 0 [(unIData (force headList args))]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger 1 index) + (delay + (delay + (constr 1 + [ ((\tup -> + (\index -> + (\args -> + force + (force + (force + ifThenElse + (equalsInteger + 1 + index) + (delay + (delay + (constr 1 + [ ]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (delay + (constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (delay + ((\l -> + constr 0 + [ ((\tup -> + (\index -> + (\args -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (delay + (constr 1 + [ ]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 1 + index) + (delay + (delay + (constr 0 + [ ]))) + (delay + (delay + (traceError + "PT1"))))))))))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) + , (unIData + (force + headList + l)) + , ((\tup -> + (\index -> + (\args -> + force + (force + (force + ifThenElse + (equalsInteger + 0 + index) + (delay + (delay + (constr 1 + [ ]))) + (delay + (delay + (force + (force + (force + ifThenElse + (equalsInteger + 1 + index) + (delay + (delay + (constr 0 + [ ]))) + (delay + (delay + (traceError + "PT1"))))))))))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + (force + tailList + l)))) ]) + (force + tailList + args)))) + (delay + (delay + (traceError + "PT1")))))) + (force + (force + sndPair) + tup)) + (force + (force + fstPair) + tup)) + (unConstrData + (force + headList + args))) ]))) + (delay + (delay + (traceError + "PT1"))))))))))) + (force + (force sndPair) + tup)) + (force (force fstPair) + tup)) + (unConstrData + (force headList + args))) ]))) + (delay + (delay (traceError "PT1"))))))))))) + (force (force sndPair) tup)) + (force (force fstPair) tup)) + (unConstrData + (constrData + 1 + (force mkCons + (constrData + 0 + (force mkCons + (constrData + 0 + (force mkCons + (Constr 1 []) + (force mkCons + (iData 1) + (force mkCons (Constr 0 []) [])))) + [])) + [])))) + (\str -> (\x -> error) (force trace str (constr 0 []))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NegativeLiterals.pir.golden b/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NegativeLiterals.pir.golden index c250a5158ce..8fad28782d2 100644 --- a/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NegativeLiterals.pir.golden +++ b/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NegativeLiterals.pir.golden @@ -1,35 +1,20 @@ -(program +program 1.1.0 - (lam - x - (con integer) - [ - [ (builtin addInteger) (con integer 24680135792468013579) ] - [ - [ (builtin addInteger) (con integer -99887766554433221100) ] - [ - [ (builtin addInteger) (con integer 98765432109876543210) ] - [ - [ (builtin addInteger) (con integer -654) ] - [ - [ (builtin addInteger) (con integer 456) ] - [ - [ (builtin addInteger) (con integer 13579246801357924680) ] - [ - [ (builtin addInteger) (con integer -11223344556677889900) ] - [ - [ (builtin addInteger) (con integer 12345678901234567890) ] - [ - [ (builtin addInteger) (con integer -321) ] - [ [ (builtin multiplyInteger) (con integer 123) ] x ] - ] - ] - ] - ] - ] - ] - ] - ] - ] - ) -) \ No newline at end of file + (\(x : integer) -> + addInteger + 24680135792468013579 + (addInteger + -99887766554433221100 + (addInteger + 98765432109876543210 + (addInteger + -654 + (addInteger + 456 + (addInteger + 13579246801357924680 + (addInteger + -11223344556677889900 + (addInteger + 12345678901234567890 + (addInteger -321 (multiplyInteger 123 x)))))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NoNegativeLiterals.pir.golden b/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NoNegativeLiterals.pir.golden index c250a5158ce..8fad28782d2 100644 --- a/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NoNegativeLiterals.pir.golden +++ b/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NoNegativeLiterals.pir.golden @@ -1,35 +1,20 @@ -(program +program 1.1.0 - (lam - x - (con integer) - [ - [ (builtin addInteger) (con integer 24680135792468013579) ] - [ - [ (builtin addInteger) (con integer -99887766554433221100) ] - [ - [ (builtin addInteger) (con integer 98765432109876543210) ] - [ - [ (builtin addInteger) (con integer -654) ] - [ - [ (builtin addInteger) (con integer 456) ] - [ - [ (builtin addInteger) (con integer 13579246801357924680) ] - [ - [ (builtin addInteger) (con integer -11223344556677889900) ] - [ - [ (builtin addInteger) (con integer 12345678901234567890) ] - [ - [ (builtin addInteger) (con integer -321) ] - [ [ (builtin multiplyInteger) (con integer 123) ] x ] - ] - ] - ] - ] - ] - ] - ] - ] - ] - ) -) \ No newline at end of file + (\(x : integer) -> + addInteger + 24680135792468013579 + (addInteger + -99887766554433221100 + (addInteger + 98765432109876543210 + (addInteger + -654 + (addInteger + 456 + (addInteger + 13579246801357924680 + (addInteger + -11223344556677889900 + (addInteger + 12345678901234567890 + (addInteger -321 (multiplyInteger 123 x)))))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NegativeLiterals.pir.golden b/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NegativeLiterals.pir.golden index c250a5158ce..8fad28782d2 100644 --- a/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NegativeLiterals.pir.golden +++ b/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NegativeLiterals.pir.golden @@ -1,35 +1,20 @@ -(program +program 1.1.0 - (lam - x - (con integer) - [ - [ (builtin addInteger) (con integer 24680135792468013579) ] - [ - [ (builtin addInteger) (con integer -99887766554433221100) ] - [ - [ (builtin addInteger) (con integer 98765432109876543210) ] - [ - [ (builtin addInteger) (con integer -654) ] - [ - [ (builtin addInteger) (con integer 456) ] - [ - [ (builtin addInteger) (con integer 13579246801357924680) ] - [ - [ (builtin addInteger) (con integer -11223344556677889900) ] - [ - [ (builtin addInteger) (con integer 12345678901234567890) ] - [ - [ (builtin addInteger) (con integer -321) ] - [ [ (builtin multiplyInteger) (con integer 123) ] x ] - ] - ] - ] - ] - ] - ] - ] - ] - ] - ) -) \ No newline at end of file + (\(x : integer) -> + addInteger + 24680135792468013579 + (addInteger + -99887766554433221100 + (addInteger + 98765432109876543210 + (addInteger + -654 + (addInteger + 456 + (addInteger + 13579246801357924680 + (addInteger + -11223344556677889900 + (addInteger + 12345678901234567890 + (addInteger -321 (multiplyInteger 123 x)))))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NoNegativeLiterals.pir.golden b/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NoNegativeLiterals.pir.golden index c250a5158ce..8fad28782d2 100644 --- a/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NoNegativeLiterals.pir.golden +++ b/plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NoNegativeLiterals.pir.golden @@ -1,35 +1,20 @@ -(program +program 1.1.0 - (lam - x - (con integer) - [ - [ (builtin addInteger) (con integer 24680135792468013579) ] - [ - [ (builtin addInteger) (con integer -99887766554433221100) ] - [ - [ (builtin addInteger) (con integer 98765432109876543210) ] - [ - [ (builtin addInteger) (con integer -654) ] - [ - [ (builtin addInteger) (con integer 456) ] - [ - [ (builtin addInteger) (con integer 13579246801357924680) ] - [ - [ (builtin addInteger) (con integer -11223344556677889900) ] - [ - [ (builtin addInteger) (con integer 12345678901234567890) ] - [ - [ (builtin addInteger) (con integer -321) ] - [ [ (builtin multiplyInteger) (con integer 123) ] x ] - ] - ] - ] - ] - ] - ] - ] - ] - ] - ) -) \ No newline at end of file + (\(x : integer) -> + addInteger + 24680135792468013579 + (addInteger + -99887766554433221100 + (addInteger + 98765432109876543210 + (addInteger + -654 + (addInteger + 456 + (addInteger + 13579246801357924680 + (addInteger + -11223344556677889900 + (addInteger + 12345678901234567890 + (addInteger -321 (multiplyInteger 123 x)))))))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/bytestring.eval.golden b/plutus-tx-plugin/test/IsData/9.6/bytestring.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/bytestring.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/bytestring.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/int.eval.golden b/plutus-tx-plugin/test/IsData/9.6/int.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/int.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/int.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/list.eval.golden b/plutus-tx-plugin/test/IsData/9.6/list.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/list.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/list.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/matchAsDataE.eval.golden b/plutus-tx-plugin/test/IsData/9.6/matchAsDataE.eval.golden index ab13a55a15b..77a22a37ae9 100644 --- a/plutus-tx-plugin/test/IsData/9.6/matchAsDataE.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/matchAsDataE.eval.golden @@ -1 +1 @@ -(con data (Constr 0 [Constr 0 []])) \ No newline at end of file +Constr 0 [Constr 0 []] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/mono.eval.golden b/plutus-tx-plugin/test/IsData/9.6/mono.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/mono.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/mono.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/nested.eval.golden b/plutus-tx-plugin/test/IsData/9.6/nested.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/nested.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/nested.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/poly.eval.golden b/plutus-tx-plugin/test/IsData/9.6/poly.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/poly.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/poly.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/record.eval.golden b/plutus-tx-plugin/test/IsData/9.6/record.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/record.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/record.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/tuple.eval.golden b/plutus-tx-plugin/test/IsData/9.6/tuple.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/tuple.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/tuple.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/tupleInterop.eval.golden b/plutus-tx-plugin/test/IsData/9.6/tupleInterop.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/tupleInterop.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/tupleInterop.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/unit.eval.golden b/plutus-tx-plugin/test/IsData/9.6/unit.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/unit.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/unit.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/unitInterop.eval.golden b/plutus-tx-plugin/test/IsData/9.6/unitInterop.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/unitInterop.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/unitInterop.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/IsData/9.6/unsafeTupleInterop.eval.golden b/plutus-tx-plugin/test/IsData/9.6/unsafeTupleInterop.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/IsData/9.6/unsafeTupleInterop.eval.golden +++ b/plutus-tx-plugin/test/IsData/9.6/unsafeTupleInterop.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/boolInterop.eval.golden b/plutus-tx-plugin/test/Lift/9.6/boolInterop.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/Lift/9.6/boolInterop.eval.golden +++ b/plutus-tx-plugin/test/Lift/9.6/boolInterop.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/bytestring.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/bytestring.uplc.golden index f5428834a57..1abec1041c1 100644 --- a/plutus-tx-plugin/test/Lift/9.6/bytestring.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/bytestring.uplc.golden @@ -1,28 +1,11 @@ -(program +program 1.1.0 - [ - [ - [ - (force - (delay - (lam - `Lift.Spec.WrappedBS_i0` - (lam `match_Lift.Spec.WrappedBS_i0` `Lift.Spec.WrappedBS_i2`) - ) - ) - ) - (lam arg_0_i0 (constr 0 arg_0_i1)) - ] - (lam - x_i0 - (delay - (lam - `case_Lift.Spec.WrappedBS_i0` - (case x_i2 `case_Lift.Spec.WrappedBS_i1`) - ) - ) - ) - ] - (con bytestring #68656c6c6f) - ] -) \ No newline at end of file + (force + (delay + (\`Lift.Spec.WrappedBS` `match_Lift.Spec.WrappedBS` -> + `Lift.Spec.WrappedBS`)) + (\arg_0 -> constr 0 [arg_0]) + (\x -> + delay + (\`case_Lift.Spec.WrappedBS` -> case x [`case_Lift.Spec.WrappedBS`])) + #68656c6c6f) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/int.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/int.uplc.golden index c897a619d7e..0d9b8af24ca 100644 --- a/plutus-tx-plugin/test/Lift/9.6/int.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/int.uplc.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 1)) \ No newline at end of file +program 1.1.0 1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/list.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/list.uplc.golden index 6ce476986b2..46f5cd08347 100644 --- a/plutus-tx-plugin/test/Lift/9.6/list.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/list.uplc.golden @@ -1,42 +1,13 @@ -(program +program 1.1.0 - [ - [ - [ - (force - (delay - (lam - `GHC.Types.Nil_i0` - (lam - `GHC.Types.Cons_i0` - (lam - `match_GHC.Types.List_i0` - [ - [ (force `GHC.Types.Cons_i2`) (con integer 1) ] - (force `GHC.Types.Nil_i3`) - ] - ) - ) - ) - ) - ) - (delay (constr 0)) - ] - (delay (lam arg_0_i0 (lam arg_1_i0 (constr 1 arg_0_i2 arg_1_i1)))) - ] - (delay - (lam - x_i0 - (delay - (lam - `case_GHC.Types.Nil_i0` - (lam - `case_GHC.Types.Cons_i0` - (case x_i3 `case_GHC.Types.Nil_i2` `case_GHC.Types.Cons_i1`) - ) - ) - ) - ) - ) - ] -) \ No newline at end of file + (force + (delay + (\`GHC.Types.Nil` `GHC.Types.Cons` `match_GHC.Types.List` -> + force `GHC.Types.Cons` 1 (force `GHC.Types.Nil`))) + (delay (constr 0 [])) + (delay (\arg_0 arg_1 -> constr 1 [arg_0, arg_1])) + (delay + (\x -> + delay + (\`case_GHC.Types.Nil` `case_GHC.Types.Cons` -> + case x [`case_GHC.Types.Nil`, `case_GHC.Types.Cons`])))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/listInterop.eval.golden b/plutus-tx-plugin/test/Lift/9.6/listInterop.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Lift/9.6/listInterop.eval.golden +++ b/plutus-tx-plugin/test/Lift/9.6/listInterop.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/mono.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/mono.uplc.golden index 3e5354daa25..01d5641c6c5 100644 --- a/plutus-tx-plugin/test/Lift/9.6/mono.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/mono.uplc.golden @@ -1,54 +1,23 @@ -(program +program 1.1.0 - [ - [ - [ - [ - [ - (force - (delay - (lam - `Plugin.Data.Spec.Mono1_i0` - (lam - `Plugin.Data.Spec.Mono2_i0` - (lam - `Plugin.Data.Spec.Mono3_i0` - (lam - `match_Plugin.Data.Spec.MyMonoData_i0` - `Plugin.Data.Spec.Mono2_i3` - ) - ) - ) - ) - ) - ) - (lam arg_0_i0 (lam arg_1_i0 (constr 0 arg_0_i2 arg_1_i1))) - ] - (lam arg_0_i0 (constr 1 arg_0_i1)) - ] - (lam arg_0_i0 (constr 2 arg_0_i1)) - ] - (lam - x_i0 - (delay - (lam - `case_Plugin.Data.Spec.Mono1_i0` - (lam - `case_Plugin.Data.Spec.Mono2_i0` - (lam - `case_Plugin.Data.Spec.Mono3_i0` - (case - x_i4 - `case_Plugin.Data.Spec.Mono1_i3` - `case_Plugin.Data.Spec.Mono2_i2` - `case_Plugin.Data.Spec.Mono3_i1` - ) - ) - ) - ) - ) - ) - ] - (con integer 2) - ] -) \ No newline at end of file + (force + (delay + (\`Plugin.Data.Spec.Mono1` + `Plugin.Data.Spec.Mono2` + `Plugin.Data.Spec.Mono3` + `match_Plugin.Data.Spec.MyMonoData` -> + `Plugin.Data.Spec.Mono2`)) + (\arg_0 arg_1 -> constr 0 [arg_0, arg_1]) + (\arg_0 -> constr 1 [arg_0]) + (\arg_0 -> constr 2 [arg_0]) + (\x -> + delay + (\`case_Plugin.Data.Spec.Mono1` + `case_Plugin.Data.Spec.Mono2` + `case_Plugin.Data.Spec.Mono3` -> + case + x + [ `case_Plugin.Data.Spec.Mono1` + , `case_Plugin.Data.Spec.Mono2` + , `case_Plugin.Data.Spec.Mono3` ])) + 2) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/monoInterop.eval.golden b/plutus-tx-plugin/test/Lift/9.6/monoInterop.eval.golden index d135c1204f4..d8263ee9860 100644 --- a/plutus-tx-plugin/test/Lift/9.6/monoInterop.eval.golden +++ b/plutus-tx-plugin/test/Lift/9.6/monoInterop.eval.golden @@ -1 +1 @@ -(con integer 2) \ No newline at end of file +2 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/nested.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/nested.uplc.golden index df1231c0ba8..af82936fa25 100644 --- a/plutus-tx-plugin/test/Lift/9.6/nested.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/nested.uplc.golden @@ -1,109 +1,38 @@ -(program +program 1.1.0 - [ - [ - (force + (force + (delay + (\`GHC.Tuple.Prim.Tuple2` `match_GHC.Tuple.Prim.Tuple2` -> + force + (delay + (\`GHC.Maybe.Just` + `GHC.Maybe.Nothing` + `match_GHC.Maybe.Maybe` -> + force + (delay + (\`Lift.Spec.NestedRecord` + `match_Lift.Spec.NestedRecord` -> + `Lift.Spec.NestedRecord`)) + (\arg_0 -> constr 0 [arg_0]) + (\x -> + delay + (\`case_Lift.Spec.NestedRecord` -> + case x [`case_Lift.Spec.NestedRecord`])) + (force `GHC.Maybe.Just` + (force (force `GHC.Tuple.Prim.Tuple2`) 1 2)))) + (delay (\arg_0 -> constr 0 [arg_0])) + (delay (constr 1 [])) + (delay + (\x -> + delay + (\`case_GHC.Maybe.Just` `case_GHC.Maybe.Nothing` -> + case + x + [`case_GHC.Maybe.Just`, `case_GHC.Maybe.Nothing`]))))) + (delay (delay (\arg_0 arg_1 -> constr 0 [arg_0, arg_1]))) + (delay (delay - (lam - `GHC.Tuple.Prim.Tuple2_i0` - (lam - `match_GHC.Tuple.Prim.Tuple2_i0` - [ - [ - [ - (force - (delay - (lam - `GHC.Maybe.Just_i0` - (lam - `GHC.Maybe.Nothing_i0` - (lam - `match_GHC.Maybe.Maybe_i0` - [ - [ - [ - (force - (delay - (lam - `Lift.Spec.NestedRecord_i0` - (lam - `match_Lift.Spec.NestedRecord_i0` - `Lift.Spec.NestedRecord_i2` - ) - ) - ) - ) - (lam arg_0_i0 (constr 0 arg_0_i1)) - ] - (lam - x_i0 - (delay - (lam - `case_Lift.Spec.NestedRecord_i0` - (case - x_i2 `case_Lift.Spec.NestedRecord_i1` - ) - ) - ) - ) - ] - [ - (force `GHC.Maybe.Just_i3`) - [ - [ - (force (force `GHC.Tuple.Prim.Tuple2_i5`)) - (con integer 1) - ] - (con integer 2) - ] - ] - ] - ) - ) - ) - ) - ) - (delay (lam arg_0_i0 (constr 0 arg_0_i1))) - ] - (delay (constr 1)) - ] - (delay - (lam - x_i0 - (delay - (lam - `case_GHC.Maybe.Just_i0` - (lam - `case_GHC.Maybe.Nothing_i0` - (case - x_i3 - `case_GHC.Maybe.Just_i2` - `case_GHC.Maybe.Nothing_i1` - ) - ) - ) - ) - ) - ) - ] - ) - ) - ) - ) - (delay (delay (lam arg_0_i0 (lam arg_1_i0 (constr 0 arg_0_i2 arg_1_i1))))) - ] - (delay - (delay - (lam - x_i0 - (delay - (lam - `case_GHC.Tuple.Prim.Tuple2_i0` - (case x_i2 `case_GHC.Tuple.Prim.Tuple2_i1`) - ) - ) - ) - ) - ) - ] -) \ No newline at end of file + (\x -> + delay + (\`case_GHC.Tuple.Prim.Tuple2` -> + case x [`case_GHC.Tuple.Prim.Tuple2`]))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/newtypeInt.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/newtypeInt.uplc.golden index c897a619d7e..0d9b8af24ca 100644 --- a/plutus-tx-plugin/test/Lift/9.6/newtypeInt.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/newtypeInt.uplc.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 1)) \ No newline at end of file +program 1.1.0 1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/newtypeInt2.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/newtypeInt2.uplc.golden index c897a619d7e..0d9b8af24ca 100644 --- a/plutus-tx-plugin/test/Lift/9.6/newtypeInt2.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/newtypeInt2.uplc.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 1)) \ No newline at end of file +program 1.1.0 1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/newtypeInt3.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/newtypeInt3.uplc.golden index c897a619d7e..0d9b8af24ca 100644 --- a/plutus-tx-plugin/test/Lift/9.6/newtypeInt3.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/newtypeInt3.uplc.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 1)) \ No newline at end of file +program 1.1.0 1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/poly.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/poly.uplc.golden index 37c366ce476..34fbd64e7d5 100644 --- a/plutus-tx-plugin/test/Lift/9.6/poly.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/poly.uplc.golden @@ -1,59 +1,24 @@ -(program +program 1.1.0 - [ - [ - (force + (force + (force (force - [ - [ - [ - (force - (delay - (lam - `Plugin.Data.Spec.Poly1_i0` - (lam - `Plugin.Data.Spec.Poly2_i0` - (lam - `match_Plugin.Data.Spec.MyPolyData_i0` - `Plugin.Data.Spec.Poly1_i3` - ) - ) - ) - ) - ) - (delay - (delay - (lam arg_0_i0 (lam arg_1_i0 (constr 0 arg_0_i2 arg_1_i1))) - ) - ) - ] - (delay (delay (lam arg_0_i0 (constr 1 arg_0_i1)))) - ] - (delay + (delay + (\`Plugin.Data.Spec.Poly1` + `Plugin.Data.Spec.Poly2` + `match_Plugin.Data.Spec.MyPolyData` -> + `Plugin.Data.Spec.Poly1`)) + (delay (delay (\arg_0 arg_1 -> constr 0 [arg_0, arg_1]))) + (delay (delay (\arg_0 -> constr 1 [arg_0]))) + (delay (delay - (lam - x_i0 - (delay - (lam - `case_Plugin.Data.Spec.Poly1_i0` - (lam - `case_Plugin.Data.Spec.Poly2_i0` - (case - x_i3 - `case_Plugin.Data.Spec.Poly1_i2` - `case_Plugin.Data.Spec.Poly2_i1` - ) - ) - ) - ) - ) - ) - ) - ] - ) - ) - (con integer 1) - ] - (con integer 2) - ] -) \ No newline at end of file + (\x -> + delay + (\`case_Plugin.Data.Spec.Poly1` + `case_Plugin.Data.Spec.Poly2` -> + case + x + [ `case_Plugin.Data.Spec.Poly1` + , `case_Plugin.Data.Spec.Poly2` ])))))) + 1 + 2) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/polyInterop.eval.golden b/plutus-tx-plugin/test/Lift/9.6/polyInterop.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Lift/9.6/polyInterop.eval.golden +++ b/plutus-tx-plugin/test/Lift/9.6/polyInterop.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/record.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/record.uplc.golden index 6afcea88e27..1cb08bcde10 100644 --- a/plutus-tx-plugin/test/Lift/9.6/record.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/record.uplc.golden @@ -1,34 +1,14 @@ -(program +program 1.1.0 - [ - [ - [ - [ - (force - (delay - (lam - `Plugin.Data.Spec.MyMonoRecord_i0` - (lam - `match_Plugin.Data.Spec.MyMonoRecord_i0` - `Plugin.Data.Spec.MyMonoRecord_i2` - ) - ) - ) - ) - (lam arg_0_i0 (lam arg_1_i0 (constr 0 arg_0_i2 arg_1_i1))) - ] - (lam - x_i0 - (delay - (lam - `case_Plugin.Data.Spec.MyMonoRecord_i0` - (case x_i2 `case_Plugin.Data.Spec.MyMonoRecord_i1`) - ) - ) - ) - ] - (con integer 1) - ] - (con integer 2) - ] -) \ No newline at end of file + (force + (delay + (\`Plugin.Data.Spec.MyMonoRecord` + `match_Plugin.Data.Spec.MyMonoRecord` -> + `Plugin.Data.Spec.MyMonoRecord`)) + (\arg_0 arg_1 -> constr 0 [arg_0, arg_1]) + (\x -> + delay + (\`case_Plugin.Data.Spec.MyMonoRecord` -> + case x [`case_Plugin.Data.Spec.MyMonoRecord`])) + 1 + 2) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/syn.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/syn.uplc.golden index 36a3b71fcb8..df57e3f2def 100644 --- a/plutus-tx-plugin/test/Lift/9.6/syn.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/syn.uplc.golden @@ -1,49 +1,17 @@ -(program +program 1.1.0 - [ - [ - (force - (delay - (lam - `Lift.Spec.Z_i0` - (lam - `match_Lift.Spec.Z_i0` - [ - [ - [ - (force - (delay - (lam - `Lift.Spec.SynExample_i0` - (lam - `match_Lift.Spec.SynExample_i0` - `Lift.Spec.SynExample_i2` - ) - ) - ) - ) - (lam arg_0_i0 (constr 0 arg_0_i1)) - ] - (lam - x_i0 - (delay - (lam - `case_Lift.Spec.SynExample_i0` - (case x_i2 `case_Lift.Spec.SynExample_i1`) - ) - ) - ) - ] - [ `Lift.Spec.Z_i2` (con integer 1) ] - ] - ) - ) - ) - ) - (lam arg_0_i0 (constr 0 arg_0_i1)) - ] - (lam - x_i0 (delay (lam `case_Lift.Spec.Z_i0` (case x_i2 `case_Lift.Spec.Z_i1`))) - ) - ] -) \ No newline at end of file + (force + (delay + (\`Lift.Spec.Z` `match_Lift.Spec.Z` -> + force + (delay + (\`Lift.Spec.SynExample` `match_Lift.Spec.SynExample` -> + `Lift.Spec.SynExample`)) + (\arg_0 -> constr 0 [arg_0]) + (\x -> + delay + (\`case_Lift.Spec.SynExample` -> + case x [`case_Lift.Spec.SynExample`])) + (`Lift.Spec.Z` 1))) + (\arg_0 -> constr 0 [arg_0]) + (\x -> delay (\`case_Lift.Spec.Z` -> case x [`case_Lift.Spec.Z`]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Lift/9.6/tuple.uplc.golden b/plutus-tx-plugin/test/Lift/9.6/tuple.uplc.golden index 267ab6e3789..9cc4e504c7e 100644 --- a/plutus-tx-plugin/test/Lift/9.6/tuple.uplc.golden +++ b/plutus-tx-plugin/test/Lift/9.6/tuple.uplc.golden @@ -1,46 +1,17 @@ -(program +program 1.1.0 - [ - [ - (force + (force + (force (force - [ - [ - (force - (delay - (lam - `GHC.Tuple.Prim.Tuple2_i0` - (lam - `match_GHC.Tuple.Prim.Tuple2_i0` - `GHC.Tuple.Prim.Tuple2_i2` - ) - ) - ) - ) + (delay + (\`GHC.Tuple.Prim.Tuple2` `match_GHC.Tuple.Prim.Tuple2` -> + `GHC.Tuple.Prim.Tuple2`)) + (delay (delay (\arg_0 arg_1 -> constr 0 [arg_0, arg_1]))) + (delay (delay - (delay - (lam arg_0_i0 (lam arg_1_i0 (constr 0 arg_0_i2 arg_1_i1))) - ) - ) - ] - (delay - (delay - (lam - x_i0 - (delay - (lam - `case_GHC.Tuple.Prim.Tuple2_i0` - (case x_i2 `case_GHC.Tuple.Prim.Tuple2_i1`) - ) - ) - ) - ) - ) - ] - ) - ) - (con integer 1) - ] - (con integer 2) - ] -) \ No newline at end of file + (\x -> + delay + (\`case_GHC.Tuple.Prim.Tuple2` -> + case x [`case_GHC.Tuple.Prim.Tuple2`])))))) + 1 + 2) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Optimization/9.6/maybeFun.uplc.golden b/plutus-tx-plugin/test/Optimization/9.6/maybeFun.uplc.golden index ea1a928b96e..d2899d853e9 100644 --- a/plutus-tx-plugin/test/Optimization/9.6/maybeFun.uplc.golden +++ b/plutus-tx-plugin/test/Optimization/9.6/maybeFun.uplc.golden @@ -1,30 +1,14 @@ -(program +program 1.1.0 - (lam - ds_i0 - (lam - ds_i0 - (force - (case - ds_i2 - (lam - x'_i0 - (delay - (force - (case - ds_i2 - (lam - y'_i0 - (delay (constr 0 [ [ (builtin addInteger) x'_i2 ] y'_i1 ])) - ) - (delay (constr 1)) - ) - ) - ) - ) - (delay (constr 1)) - ) - ) - ) - ) -) \ No newline at end of file + (\ds ds -> + force + (case + ds + [ (\x' -> + delay + (force + (case + ds + [ (\y' -> delay (constr 0 [(addInteger x' y')])) + , (delay (constr 1 [])) ]))) + , (delay (constr 1 [])) ])) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/defaultCaseDuplication.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/defaultCaseDuplication.pir.golden index be3bffbc56e..fc6ae40a03d 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/defaultCaseDuplication.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/defaultCaseDuplication.pir.golden @@ -1,33 +1,20 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind (nonstrict) (vardecl defaultBody (con integer)) (con integer 2)) - (datatypebind - (datatype - (tyvardecl A (type)) A_match (vardecl B A) (vardecl C A) (vardecl D A) - ) - ) - (lam + ~defaultBody : integer = 2 + data A | A_match where + B : A + C : A + D : A + in + \(ds : A) -> + let + !ds : A = ds + in + A_match ds - A - (let - (nonrec) - (termbind (strict) (vardecl ds A) ds) - { - [ - [ - [ - { [ A_match ds ] (all dead (type) (con integer)) } - (abs dead (type) (con integer 1)) - ] - (abs dead (type) defaultBody) - ] - (abs dead (type) defaultBody) - ] - (all dead (type) dead) - } - ) - ) - ) -) \ No newline at end of file + {all dead. integer} + (/\dead -> 1) + (/\dead -> defaultBody) + (/\dead -> defaultBody) + {all dead. dead}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/defaultCaseDuplicationNested.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/defaultCaseDuplicationNested.pir.golden index f74fea27b8b..37bf137da63 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/defaultCaseDuplicationNested.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/defaultCaseDuplicationNested.pir.golden @@ -1,58 +1,32 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind (nonstrict) (vardecl defaultBody (con integer)) (con integer 3)) - (datatypebind - (datatype - (tyvardecl A (type)) A_match (vardecl B A) (vardecl C A) (vardecl D A) - ) - ) - (lam - ds - A - (let - (nonrec) - (termbind (strict) (vardecl ds A) ds) - (lam - ds - A - (let - (nonrec) - (termbind (strict) (vardecl ds A) ds) - (termbind - (nonstrict) - (vardecl defaultBody (con integer)) - { - [ - [ - [ - { [ A_match ds ] (all dead (type) (con integer)) } - (abs dead (type) (con integer 2)) - ] - (abs dead (type) defaultBody) - ] - (abs dead (type) defaultBody) - ] - (all dead (type) dead) - } - ) - { - [ - [ - [ - { [ A_match ds ] (all dead (type) (con integer)) } - (abs dead (type) (con integer 1)) - ] - (abs dead (type) defaultBody) - ] - (abs dead (type) defaultBody) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) -) \ No newline at end of file + ~defaultBody : integer = 3 + data A | A_match where + B : A + C : A + D : A + in + \(ds : A) -> + let + !ds : A = ds + in + \(ds : A) -> + let + !ds : A = ds + ~defaultBody : integer + = A_match + ds + {all dead. integer} + (/\dead -> 2) + (/\dead -> defaultBody) + (/\dead -> defaultBody) + {all dead. dead} + in + A_match + ds + {all dead. integer} + (/\dead -> 1) + (/\dead -> defaultBody) + (/\dead -> defaultBody) + {all dead. dead}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden index b99125842ce..db3616eaaab 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOpt.pir.golden @@ -1,87 +1,29 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl - divideInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin divideInteger) - ) - (termbind - (nonstrict) - (vardecl - divideInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ divideInteger x ] y ] - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl wild Bool) - [ - [ equalsInteger [ [ divideInteger (con integer 1) ] (con integer 0) ] ] - (con integer 0) - ] - ) - (con integer 1) - ) -) \ No newline at end of file + !divideInteger : integer -> integer -> integer = divideInteger + ~divideInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in divideInteger x y + data Bool | Bool_match where + True : Bool + False : Bool + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + !wild : Bool = equalsInteger (divideInteger 1 0) 0 + in + 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOptEval.eval.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOptEval.eval.golden index 31522decfd6..17922fad000 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOptEval.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/ifOptEval.eval.golden @@ -1,6 +1,6 @@ An error has occurred: The machine terminated because of an error, either from a built-in function or from an explicit use of 'error'. -Caused by: (divideInteger 1 0) +Caused by: divideInteger 1 0 Final budget: ({cpu: 132030 | mem: 101}) Logs: Cannot divide by zero \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden index bc35ea6a6bd..210db8b4ce5 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/letFun.pir.golden @@ -1,65 +1,25 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ [ equalsInteger ds ] ds ] - ) - ) - ) - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> let !ds : integer = ds in equalsInteger ds ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/monadicDo.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/monadicDo.pir.golden index b6afb8204de..4d7ba359c3f 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/monadicDo.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/monadicDo.pir.golden @@ -1,127 +1,51 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - (termbind - (nonstrict) - (vardecl `$fApplicativeMaybe_$cpure` (all a (type) (fun a [ Maybe a ]))) - (abs a (type) (lam ds a [ { Just a } ds ])) - ) - (termbind - (nonstrict) - (vardecl - `$fMonadMaybe_$c>>=` - (all - a - (type) - (all b (type) (fun [ Maybe a ] (fun (fun a [ Maybe b ]) [ Maybe b ]))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - ds - [ Maybe a ] - (lam - k - (fun a [ Maybe b ]) - { - [ - [ - { [ { Maybe_match a } ds ] (all dead (type) [ Maybe b ]) } - (lam x a (abs dead (type) [ k x ])) - ] - (abs dead (type) { Nothing b }) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (lam - ds - [ Maybe (con integer) ] - (let - (nonrec) - (termbind (strict) (vardecl ds [ Maybe (con integer) ]) ds) - (lam - ds - [ Maybe (con integer) ] - (let - (nonrec) - (termbind (strict) (vardecl ds [ Maybe (con integer) ]) ds) - [ - [ { { `$fMonadMaybe_$c>>=` (con integer) } (con integer) } ds ] - (lam - x' - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x' (con integer)) x') - [ - [ - { { `$fMonadMaybe_$c>>=` (con integer) } (con integer) } - ds - ] - (lam - y' - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y' (con integer)) y') - [ - { `$fApplicativeMaybe_$cpure` (con integer) } - [ [ addInteger x' ] y' ] - ] - ) - ) - ] - ) - ) - ] - ) - ) - ) - ) - ) -) \ No newline at end of file + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + ~`$fApplicativeMaybe_$cpure` : all a. a -> Maybe a + = /\a -> \(ds : a) -> Just {a} ds + ~`$fMonadMaybe_$c>>=` : all a b. Maybe a -> (a -> Maybe b) -> Maybe b + = /\a b -> + \(ds : Maybe a) (k : a -> Maybe b) -> + Maybe_match + {a} + ds + {all dead. Maybe b} + (\(x : a) -> /\dead -> k x) + (/\dead -> Nothing {b}) + {all dead. dead} + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + \(ds : Maybe integer) -> + let + !ds : Maybe integer = ds + in + \(ds : Maybe integer) -> + let + !ds : Maybe integer = ds + in + `$fMonadMaybe_$c>>=` + {integer} + {integer} + ds + (\(x' : integer) -> + let + !x' : integer = x' + in + `$fMonadMaybe_$c>>=` + {integer} + {integer} + ds + (\(y' : integer) -> + let + !y' : integer = y' + in + `$fApplicativeMaybe_$cpure` {integer} (addInteger x' y')))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/monoId.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/monoId.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/monoId.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/monoId.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/monoK.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/monoK.pir.golden index cfa4ac0ee32..5a9a14aa00a 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/monoK.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/monoK.pir.golden @@ -1,12 +1,3 @@ -(program +program 1.1.0 - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam ds (con integer) ds) - ) - ) -) \ No newline at end of file + (\(ds : integer) -> let !ds : integer = ds in \(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/nonstrictLet.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/nonstrictLet.pir.golden index 48a7e5abcab..e4cf284e5b0 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/nonstrictLet.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/nonstrictLet.pir.golden @@ -1,52 +1,21 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (termbind - (strict) (vardecl z (con integer)) [ [ addInteger ds ] ds ] - ) - [ [ addInteger z ] z ] - ) - ) - ) - ) - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> + let + !ds : integer = ds + !z : integer = addInteger ds ds + in + addInteger z z) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/patternMatchDo.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/patternMatchDo.pir.golden index 409c116c10b..94746c1b285 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/patternMatchDo.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/patternMatchDo.pir.golden @@ -1,160 +1,58 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - (termbind - (nonstrict) - (vardecl `$fApplicativeMaybe_$cpure` (all a (type) (fun a [ Maybe a ]))) - (abs a (type) (lam ds a [ { Just a } ds ])) - ) - (termbind - (nonstrict) - (vardecl - `$fMonadMaybe_$c>>=` - (all - a - (type) - (all b (type) (fun [ Maybe a ] (fun (fun a [ Maybe b ]) [ Maybe b ]))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - ds - [ Maybe a ] - (lam - k - (fun a [ Maybe b ]) - { - [ - [ - { [ { Maybe_match a } ds ] (all dead (type) [ Maybe b ]) } - (lam x a (abs dead (type) [ k x ])) - ] - (abs dead (type) { Nothing b }) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (lam - ds - [ Maybe [ [ Tuple2 (con integer) ] (con integer) ] ] - (let - (nonrec) - (termbind - (strict) - (vardecl ds [ Maybe [ [ Tuple2 (con integer) ] (con integer) ] ]) - ds - ) - (lam - ds - [ Maybe (con integer) ] - (let - (nonrec) - (termbind (strict) (vardecl ds [ Maybe (con integer) ]) ds) - [ - [ - { - { - `$fMonadMaybe_$c>>=` - [ [ Tuple2 (con integer) ] (con integer) ] - } - (con integer) - } - ds - ] - (lam - ds - [ [ Tuple2 (con integer) ] (con integer) ] - [ - { - [ { { Tuple2_match (con integer) } (con integer) } ds ] - [ Maybe (con integer) ] - } - (lam - x - (con integer) - (lam - x - (con integer) - [ - [ - { - { `$fMonadMaybe_$c>>=` (con integer) } (con integer) - } - ds - ] - (lam - y' - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y' (con integer)) y') - [ - { `$fApplicativeMaybe_$cpure` (con integer) } - [ [ addInteger [ [ addInteger x ] x ] ] y' ] - ] - ) - ) - ] - ) - ) - ] - ) - ] - ) - ) - ) - ) - ) -) \ No newline at end of file + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + ~`$fApplicativeMaybe_$cpure` : all a. a -> Maybe a + = /\a -> \(ds : a) -> Just {a} ds + ~`$fMonadMaybe_$c>>=` : all a b. Maybe a -> (a -> Maybe b) -> Maybe b + = /\a b -> + \(ds : Maybe a) (k : a -> Maybe b) -> + Maybe_match + {a} + ds + {all dead. Maybe b} + (\(x : a) -> /\dead -> k x) + (/\dead -> Nothing {b}) + {all dead. dead} + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + \(ds : Maybe (Tuple2 integer integer)) -> + let + !ds : Maybe (Tuple2 integer integer) = ds + in + \(ds : Maybe integer) -> + let + !ds : Maybe integer = ds + in + `$fMonadMaybe_$c>>=` + {Tuple2 integer integer} + {integer} + ds + (\(ds : Tuple2 integer integer) -> + Tuple2_match + {integer} + {integer} + ds + {Maybe integer} + (\(x : integer) (x : integer) -> + `$fMonadMaybe_$c>>=` + {integer} + {integer} + ds + (\(y' : integer) -> + let + !y' : integer = y' + in + `$fApplicativeMaybe_$cpure` + {integer} + (addInteger (addInteger x x) y'))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/strictLet.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/strictLet.pir.golden index 48a7e5abcab..e4cf284e5b0 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/strictLet.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/strictLet.pir.golden @@ -1,52 +1,21 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (termbind - (strict) (vardecl z (con integer)) [ [ addInteger ds ] ds ] - ) - [ [ addInteger z ] z ] - ) - ) - ) - ) - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> + let + !ds : integer = ds + !z : integer = addInteger ds ds + in + addInteger z z) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/strictLetRec.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/strictLetRec.pir.golden index 245ff864cb1..a2234ea9278 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/strictLetRec.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/strictLetRec.pir.golden @@ -1,63 +1,28 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (let - (rec) - (termbind - (nonstrict) (vardecl q (con integer)) [ [ addInteger ds ] z ] - ) - (termbind - (nonstrict) (vardecl z (con integer)) [ [ addInteger ds ] q ] - ) - (let - (nonrec) - (termbind (strict) (vardecl z (con integer)) z) - (termbind (strict) (vardecl q (con integer)) q) - [ [ addInteger z ] z ] - ) - ) - ) - ) - ) - ) - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> + let + !ds : integer = ds + in + letrec + ~q : integer = addInteger ds z + ~z : integer = addInteger ds q + in + let + !z : integer = z + !q : integer = q + in + addInteger z z) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Basic/9.6/strictMultiLet.pir.golden b/plutus-tx-plugin/test/Plugin/Basic/9.6/strictMultiLet.pir.golden index bd13e62b61f..d410ebbec43 100644 --- a/plutus-tx-plugin/test/Plugin/Basic/9.6/strictMultiLet.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Basic/9.6/strictMultiLet.pir.golden @@ -1,53 +1,22 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (termbind - (strict) (vardecl z (con integer)) [ [ addInteger ds ] ds ] - ) - (termbind (strict) (vardecl q (con integer)) [ [ addInteger z ] z ]) - [ [ addInteger q ] q ] - ) - ) - ) - ) - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> + let + !ds : integer = ds + !z : integer = addInteger ds ds + !q : integer = addInteger z z + in + addInteger q q) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden b/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden index 5062a03adda..c3e9f322fe8 100644 --- a/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Coverage/9.6/coverageCode.pir.golden @@ -1,538 +1,169 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (nonstrict) - (vardecl fail (fun (con unit) [ Maybe Bool ])) - (lam - ds - (con unit) - { - { - [ - [ - { (builtin trace) (all dead (type) (all a (type) [ Maybe a ])) } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 41, _covLocEndLine = 41, _covLocStartCol = 14, _covLocEndCol = 15})" - ) - ] - (abs - dead - (type) - { - [ - [ - { - (builtin trace) - (all dead (type) (all a (type) [ Maybe a ])) - } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 43, _covLocEndLine = 43, _covLocStartCol = 26, _covLocEndCol = 33})" - ) - ] - (abs dead (type) Nothing) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - Bool - } - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fEqInteger` [ (lam a (type) (fun a (fun a Bool))) (con integer) ] - ) - equalsInteger - ) - (termbind - (nonstrict) - (vardecl `&&` (fun Bool (fun Bool Bool))) - (lam - ds - Bool - (lam - x - Bool - { - [ - [ - { [ Bool_match ds ] (all dead (type) Bool) } (abs dead (type) x) - ] - (abs dead (type) False) - ] - (all dead (type) dead) - } - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `==` - (all - a - (type) - (fun [ (lam a (type) (fun a (fun a Bool))) a ] (fun a (fun a Bool))) - ) - ) - (abs a (type) (lam v [ (lam a (type) (fun a (fun a Bool))) a ] v)) - ) - (termbind - (strict) - (vardecl trace (all a (type) (fun (con string) (fun a a)))) - (builtin trace) - ) - (termbind - (nonstrict) - (vardecl traceBool (fun (con string) (fun (con string) (fun Bool Bool)))) - (lam - trueLabel - (con string) - (let - (nonrec) - (termbind (strict) (vardecl trueLabel (con string)) trueLabel) - (lam - falseLabel - (con string) - (let - (nonrec) - (termbind (strict) (vardecl falseLabel (con string)) falseLabel) - (lam + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + data Bool | Bool_match where + True : Bool + False : Bool + ~fail : + unit -> Maybe Bool + = \(ds : unit) -> + trace + {all dead a. Maybe a} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 41, _covLocEndLine = 41, _covLocStartCol = 14, _covLocEndCol = 15})" + (/\dead -> + trace + {all dead a. Maybe a} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 43, _covLocEndLine = 43, _covLocStartCol = 26, _covLocEndCol = 33})" + (/\dead -> Nothing) + {all dead. dead}) + {all dead. dead} + {Bool} + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + ~`$fEqInteger` : (\a -> a -> a -> Bool) integer = equalsInteger + ~`&&` : Bool -> Bool -> Bool + = \(ds : Bool) (x : Bool) -> + Bool_match + ds + {all dead. Bool} + (/\dead -> x) + (/\dead -> False) + {all dead. dead} + ~`==` : all a. (\a -> a -> a -> Bool) a -> a -> a -> Bool + = /\a -> \(v : (\a -> a -> a -> Bool) a) -> v + !trace : all a. string -> a -> a = trace + ~traceBool : string -> string -> Bool -> Bool + = \(trueLabel : string) -> + let + !trueLabel : string = trueLabel + in + \(falseLabel : string) -> + let + !falseLabel : string = falseLabel + in + \(c : Bool) -> + Bool_match c - Bool - { - [ - [ - { [ Bool_match c ] (all dead (type) Bool) } - (abs dead (type) [ [ { trace Bool } trueLabel ] True ]) - ] - (abs dead (type) [ [ { trace Bool } falseLabel ] False ]) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl otherFun (fun (con integer) Bool)) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ - [ - [ - traceBool - (con - string - "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 1, _covLocEndCol = 32}) True" - ) - ] - (con - string - "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 1, _covLocEndCol = 32}) False" - ) - ] - { - [ - [ - { (builtin trace) (all dead (type) Bool) } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 1, _covLocEndCol = 32})" - ) - ] - (abs - dead - (type) - [ - [ - [ - traceBool - (con - string - "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 32}) True" - ) - ] - (con - string - "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 32}) False" - ) - ] - { - [ - [ - { (builtin trace) (all dead (type) Bool) } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 32})" - ) - ] - (abs - dead - (type) - [ - [ - `&&` - [ - [ - [ - traceBool - (con - string - "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24}) True" - ) - ] - (con - string - "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24}) False" - ) - ] - { - [ - [ - { (builtin trace) (all dead (type) Bool) } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24})" - ) - ] - (abs - dead - (type) - [ - [ - [ - { `==` (con integer) } `$fEqInteger` - ] - { - [ - [ - { - (builtin trace) - (all - dead (type) (con integer) - ) - } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 15, _covLocEndCol = 16})" - ) - ] - (abs dead (type) x) - ] - (all dead (type) dead) - } - ] - { - [ - [ - { - (builtin trace) - (all dead (type) (con integer)) - } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 22, _covLocEndCol = 23})" - ) - ] - (abs dead (type) (con integer 5)) - ] - (all dead (type) dead) - } - ] - ) - ] - (all dead (type) dead) - } - ] - ] - { - [ - [ - { (builtin trace) (all dead (type) Bool) } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 28, _covLocEndCol = 32})" - ) - ] - (abs dead (type) True) - ] - (all dead (type) dead) - } - ] - ) - ] - (all dead (type) dead) - } - ] - ) - ] - (all dead (type) dead) - } - ] - ) - ) - ) - (lam - x - [ Maybe (con integer) ] - (let - (nonrec) - (termbind (strict) (vardecl x [ Maybe (con integer) ]) x) - { - [ - [ - { (builtin trace) (all dead (type) [ Maybe Bool ]) } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 37, _covLocEndLine = 37, _covLocStartCol = 54, _covLocEndCol = 57})" - ) - ] - (abs - dead - (type) - { - [ - [ - { (builtin trace) (all dead (type) [ Maybe Bool ]) } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 41, _covLocEndLine = 43, _covLocStartCol = 1, _covLocEndCol = 33})" - ) - ] - (abs - dead - (type) - { - [ - [ - { (builtin trace) (all dead (type) [ Maybe Bool ]) } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 41, _covLocEndLine = 43, _covLocStartCol = 9, _covLocEndCol = 33})" - ) - ] - (abs - dead - (type) - { - [ - [ - { - [ { Maybe_match (con integer) } x ] - (all dead (type) [ Maybe Bool ]) - } - (lam - y - (con integer) - (abs - dead - (type) - { - [ - [ - { - (builtin trace) - (all dead (type) [ Maybe Bool ]) - } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 42, _covLocEndLine = 42, _covLocStartCol = 12, _covLocEndCol = 22})" - ) - ] - (abs - dead - (type) - { - [ - [ - { - [ - Bool_match - [ - otherFun - { - [ - [ - { - (builtin trace) - (all - dead - (type) - (con integer) - ) - } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 42, _covLocEndLine = 42, _covLocStartCol = 21, _covLocEndCol = 22})" - ) - ] - (abs dead (type) y) - ] - (all dead (type) dead) - } - ] - ] - (all - dead (type) [ Maybe Bool ] - ) - } - (abs - dead - (type) - { - [ - [ - { - (builtin trace) - (all - dead - (type) - [ Maybe Bool ] - ) - } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 42, _covLocEndLine = 42, _covLocStartCol = 26, _covLocEndCol = 36})" - ) - ] - (abs - dead - (type) - [ - { Just Bool } - { - [ - [ - { - (builtin - trace - ) - (all - dead - (type) - Bool - ) - } - (con - string - "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 42, _covLocEndLine = 42, _covLocStartCol = 31, _covLocEndCol = 36})" - ) - ] - (abs - dead - (type) - False - ) - ] - (all - dead (type) dead - ) - } - ] - ) - ] - (all dead (type) dead) - } - ) - ] - (abs - dead - (type) - [ fail (con unit ()) ] - ) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ) - ) - ] - (abs dead (type) [ fail (con unit ()) ]) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ) - ) - ) -) \ No newline at end of file + {all dead. Bool} + (/\dead -> trace {Bool} trueLabel True) + (/\dead -> trace {Bool} falseLabel False) + {all dead. dead} + ~otherFun : + integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + traceBool + "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 1, _covLocEndCol = 32}) True" + "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 1, _covLocEndCol = 32}) False" + (trace + {all dead. Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 1, _covLocEndCol = 32})" + (/\dead -> + traceBool + "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 32}) True" + "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 32}) False" + (trace + {all dead. Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 32})" + (/\dead -> + `&&` + (traceBool + "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24}) True" + "CoverBool (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24}) False" + (trace + {all dead. Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 14, _covLocEndCol = 24})" + (/\dead -> + `==` + {integer} + `$fEqInteger` + (trace + {all dead. integer} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 15, _covLocEndCol = 16})" + (/\dead -> x) + {all dead. dead}) + (trace + {all dead. integer} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 22, _covLocEndCol = 23})" + (/\dead -> 5) + {all dead. dead})) + {all dead. dead})) + (trace + {all dead. Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 46, _covLocEndLine = 46, _covLocStartCol = 28, _covLocEndCol = 32})" + (/\dead -> True) + {all dead. dead})) + {all dead. dead})) + {all dead. dead}) + in + \(x : Maybe integer) -> + let + !x : Maybe integer = x + in + trace + {all dead. Maybe Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 37, _covLocEndLine = 37, _covLocStartCol = 54, _covLocEndCol = 57})" + (/\dead -> + trace + {all dead. Maybe Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 41, _covLocEndLine = 43, _covLocStartCol = 1, _covLocEndCol = 33})" + (/\dead -> + trace + {all dead. Maybe Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 41, _covLocEndLine = 43, _covLocStartCol = 9, _covLocEndCol = 33})" + (/\dead -> + Maybe_match + {integer} + x + {all dead. Maybe Bool} + (\(y : integer) -> + /\dead -> + trace + {all dead. Maybe Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 42, _covLocEndLine = 42, _covLocStartCol = 12, _covLocEndCol = 22})" + (/\dead -> + Bool_match + (otherFun + (trace + {all dead. integer} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 42, _covLocEndLine = 42, _covLocStartCol = 21, _covLocEndCol = 22})" + (/\dead -> y) + {all dead. dead})) + {all dead. Maybe Bool} + (/\dead -> + trace + {all dead. Maybe Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 42, _covLocEndLine = 42, _covLocStartCol = 26, _covLocEndCol = 36})" + (/\dead -> + Just + {Bool} + (trace + {all dead. Bool} + "CoverLocation (CovLoc {_covLocFile = \"test/Plugin/Coverage/Spec.hs\", _covLocStartLine = 42, _covLocEndLine = 42, _covLocStartCol = 31, _covLocEndCol = 36})" + (/\dead -> False) + {all dead. dead})) + {all dead. dead}) + (/\dead -> fail ()) + {all dead. dead}) + {all dead. dead}) + (/\dead -> fail ()) + {all dead. dead}) + {all dead. dead}) + {all dead. dead}) + {all dead. dead}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/families/associated.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/families/associated.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/families/associated.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/families/associated.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/families/associatedParam.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/families/associatedParam.pir.golden index 12ec7546f95..6f90ae74523 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/families/associatedParam.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/families/associatedParam.pir.golden @@ -1,43 +1,10 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Param (fun (type) (type))) - (tyvardecl a (type)) - Param_match - (vardecl Param (fun a [ Param a ])) - ) - ) - (termbind - (nonstrict) - (vardecl `$WParam` (all a (type) (fun a [ Param a ]))) - (abs - a - (type) - (lam - conrep - a - (let - (nonrec) - (termbind (strict) (vardecl conrep a) conrep) - [ { Param a } conrep ] - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl paramId (all a (type) (fun [ Param a ] (fun a a)))) - (abs a (type) (lam ds [ Param a ] (lam x a x))) - ) - [ - [ - { paramId (con integer) } - [ { `$WParam` (con integer) } (con integer 1) ] - ] - (con integer 1) - ] - ) -) \ No newline at end of file + data (Param :: * -> *) a | Param_match where + Param : a -> Param a + ~`$WParam` : all a. a -> Param a + = /\a -> \(conrep : a) -> let !conrep : a = conrep in Param {a} conrep + ~paramId : all a. Param a -> a -> a = /\a -> \(ds : Param a) (x : a) -> x + in + paramId {integer} (`$WParam` {integer} 1) 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicClosed.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicClosed.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicClosed.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicClosed.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicData.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicData.pir.golden index 1d2df6458fc..e97563d8275 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicData.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicData.pir.golden @@ -1,26 +1,11 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl `R:BasicDataBool` (type)) - - `R:BasicDataBool_match` - (vardecl Inst (fun (con integer) `R:BasicDataBool`)) - ) - ) - (lam - ds - `R:BasicDataBool` - (let - (nonrec) - (termbind (strict) (vardecl nt `R:BasicDataBool`) ds) - [ - { [ `R:BasicDataBool_match` nt ] (con integer) } - (lam i (con integer) i) - ] - ) - ) - ) -) \ No newline at end of file + data `R:BasicDataBool` | `R:BasicDataBool_match` where + Inst : integer -> `R:BasicDataBool` + in + \(ds : `R:BasicDataBool`) -> + let + !nt : `R:BasicDataBool` = ds + in + `R:BasicDataBool_match` nt {integer} (\(i : integer) -> i)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicOpen.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicOpen.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicOpen.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/families/basicOpen.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/atPattern.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/atPattern.pir.golden index 904ad70c7c5..166246d17a8 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/atPattern.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/atPattern.pir.golden @@ -1,48 +1,20 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (lam + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + \(t : Tuple2 integer integer) -> + Tuple2_match + {integer} + {integer} t - [ [ Tuple2 (con integer) ] (con integer) ] - [ - { [ { { Tuple2_match (con integer) } (con integer) } t ] (con integer) } - (lam ds (con integer) (lam ds (con integer) [ [ addInteger ds ] ds ])) - ] - ) - ) -) \ No newline at end of file + {integer} + (\(ds : integer) (ds : integer) -> addInteger ds ds)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/defaultCase.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/defaultCase.pir.golden index 8c7d3487e43..11face25ff7 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/defaultCase.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/defaultCase.pir.golden @@ -1,39 +1,19 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind (nonstrict) (vardecl defaultBody (con integer)) (con integer 2)) - (datatypebind - (datatype - (tyvardecl MyMonoData (type)) - - MyMonoData_match - (vardecl Mono (fun (con integer) (fun (con integer) MyMonoData))) - (vardecl Mono (fun (con integer) MyMonoData)) - (vardecl Mono (fun (con integer) MyMonoData)) - ) - ) - (lam + ~defaultBody : integer = 2 + data MyMonoData | MyMonoData_match where + Mono : integer -> integer -> MyMonoData + Mono : integer -> MyMonoData + Mono : integer -> MyMonoData + in + \(ds : MyMonoData) -> + let + !ds : MyMonoData = ds + in + MyMonoData_match ds - MyMonoData - (let - (nonrec) - (termbind (strict) (vardecl ds MyMonoData) ds) - [ - [ - [ - { [ MyMonoData_match ds ] (con integer) } - (lam - default_arg0 - (con integer) - (lam default_arg1 (con integer) defaultBody) - ) - ] - (lam default_arg0 (con integer) defaultBody) - ] - (lam a (con integer) a) - ] - ) - ) - ) -) \ No newline at end of file + {integer} + (\(default_arg0 : integer) (default_arg1 : integer) -> defaultBody) + (\(default_arg0 : integer) -> defaultBody) + (\(a : integer) -> a)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/enum.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/enum.pir.golden index bd39e84f745..8b9f94a00ab 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/enum.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/enum.pir.golden @@ -1,15 +1,8 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyEnum (type)) - - MyEnum_match - (vardecl Enum MyEnum) (vardecl Enum MyEnum) - ) - ) - Enum - ) -) \ No newline at end of file + data MyEnum | MyEnum_match where + Enum : MyEnum + Enum : MyEnum + in + Enum) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/irrefutableMatch.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/irrefutableMatch.pir.golden index 05c3a58bde2..0d70c8027a0 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/irrefutableMatch.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/irrefutableMatch.pir.golden @@ -1,54 +1,23 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (nonstrict) - (vardecl defaultBody (con integer)) - { (abs e (type) (error e)) (con integer) } - ) - (datatypebind - (datatype (tyvardecl Unit (type)) Unit_match (vardecl Unit Unit)) - ) - (termbind - (nonstrict) - (vardecl defaultBody (con integer)) - [ - { [ Unit_match { (abs e (type) (error e)) Unit } ] (con integer) } - defaultBody - ] - ) - (datatypebind - (datatype - (tyvardecl MyMonoData (type)) - - MyMonoData_match - (vardecl Mono (fun (con integer) (fun (con integer) MyMonoData))) - (vardecl Mono (fun (con integer) MyMonoData)) - (vardecl Mono (fun (con integer) MyMonoData)) - ) - ) - (lam + ~defaultBody : integer = (/\e -> error {e}) {integer} + data Unit | Unit_match where + Unit : Unit + ~defaultBody : integer + = Unit_match ((/\e -> error {e}) {Unit}) {integer} defaultBody + data MyMonoData | MyMonoData_match where + Mono : integer -> integer -> MyMonoData + Mono : integer -> MyMonoData + Mono : integer -> MyMonoData + in + \(ds : MyMonoData) -> + let + !ds : MyMonoData = ds + in + MyMonoData_match ds - MyMonoData - (let - (nonrec) - (termbind (strict) (vardecl ds MyMonoData) ds) - [ - [ - [ - { [ MyMonoData_match ds ] (con integer) } - (lam - default_arg0 - (con integer) - (lam default_arg1 (con integer) defaultBody) - ) - ] - (lam a (con integer) a) - ] - (lam default_arg0 (con integer) defaultBody) - ] - ) - ) - ) -) \ No newline at end of file + {integer} + (\(default_arg0 : integer) (default_arg1 : integer) -> defaultBody) + (\(a : integer) -> a) + (\(default_arg0 : integer) -> defaultBody)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoCase.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoCase.pir.golden index fe9af864fc3..6e430b52b48 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoCase.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoCase.pir.golden @@ -1,34 +1,18 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyMonoData (type)) - - MyMonoData_match - (vardecl Mono (fun (con integer) (fun (con integer) MyMonoData))) - (vardecl Mono (fun (con integer) MyMonoData)) - (vardecl Mono (fun (con integer) MyMonoData)) - ) - ) - (lam + data MyMonoData | MyMonoData_match where + Mono : integer -> integer -> MyMonoData + Mono : integer -> MyMonoData + Mono : integer -> MyMonoData + in + \(ds : MyMonoData) -> + let + !ds : MyMonoData = ds + in + MyMonoData_match ds - MyMonoData - (let - (nonrec) - (termbind (strict) (vardecl ds MyMonoData) ds) - [ - [ - [ - { [ MyMonoData_match ds ] (con integer) } - (lam ds (con integer) (lam b (con integer) b)) - ] - (lam a (con integer) a) - ] - (lam a (con integer) a) - ] - ) - ) - ) -) \ No newline at end of file + {integer} + (\(ds : integer) (b : integer) -> b) + (\(a : integer) -> a) + (\(a : integer) -> a)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoCaseStrict.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoCaseStrict.pir.golden index fe9af864fc3..6e430b52b48 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoCaseStrict.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoCaseStrict.pir.golden @@ -1,34 +1,18 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyMonoData (type)) - - MyMonoData_match - (vardecl Mono (fun (con integer) (fun (con integer) MyMonoData))) - (vardecl Mono (fun (con integer) MyMonoData)) - (vardecl Mono (fun (con integer) MyMonoData)) - ) - ) - (lam + data MyMonoData | MyMonoData_match where + Mono : integer -> integer -> MyMonoData + Mono : integer -> MyMonoData + Mono : integer -> MyMonoData + in + \(ds : MyMonoData) -> + let + !ds : MyMonoData = ds + in + MyMonoData_match ds - MyMonoData - (let - (nonrec) - (termbind (strict) (vardecl ds MyMonoData) ds) - [ - [ - [ - { [ MyMonoData_match ds ] (con integer) } - (lam ds (con integer) (lam b (con integer) b)) - ] - (lam a (con integer) a) - ] - (lam a (con integer) a) - ] - ) - ) - ) -) \ No newline at end of file + {integer} + (\(ds : integer) (b : integer) -> b) + (\(a : integer) -> a) + (\(a : integer) -> a)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstDest.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstDest.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstDest.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstDest.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstDestDefault.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstDestDefault.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstDestDefault.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstDestDefault.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstructed.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstructed.pir.golden index b3e42a16e82..42adca87158 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstructed.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstructed.pir.golden @@ -1,30 +1,11 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyMonoData (type)) - - MyMonoData_match - (vardecl Mono (fun (con integer) (fun (con integer) MyMonoData))) - (vardecl Mono (fun (con integer) MyMonoData)) - (vardecl Mono (fun (con integer) MyMonoData)) - ) - ) - (termbind - (nonstrict) - (vardecl `$WMono` (fun (con integer) MyMonoData)) - (lam - conrep - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl conrep (con integer)) conrep) - [ Mono conrep ] - ) - ) - ) - [ `$WMono` (con integer 1) ] - ) -) \ No newline at end of file + data MyMonoData | MyMonoData_match where + Mono : integer -> integer -> MyMonoData + Mono : integer -> MyMonoData + Mono : integer -> MyMonoData + ~`$WMono` : integer -> MyMonoData + = \(conrep : integer) -> let !conrep : integer = conrep in Mono conrep + in + `$WMono` 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstructor.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstructor.pir.golden index 800fc951330..8316a48c601 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstructor.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoConstructor.pir.golden @@ -1,38 +1,19 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyMonoData (type)) - - MyMonoData_match - (vardecl Mono (fun (con integer) (fun (con integer) MyMonoData))) - (vardecl Mono (fun (con integer) MyMonoData)) - (vardecl Mono (fun (con integer) MyMonoData)) - ) - ) - (termbind - (nonstrict) - (vardecl `$WMono` (fun (con integer) (fun (con integer) MyMonoData))) - (lam - conrep - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl conrep (con integer)) conrep) - (lam - conrep - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl conrep (con integer)) conrep) - [ [ Mono conrep ] conrep ] - ) - ) - ) - ) - ) - (lam ds (con integer) (lam ds (con integer) [ [ `$WMono` ds ] ds ])) - ) -) \ No newline at end of file + data MyMonoData | MyMonoData_match where + Mono : integer -> integer -> MyMonoData + Mono : integer -> MyMonoData + Mono : integer -> MyMonoData + ~`$WMono` : integer -> integer -> MyMonoData + = \(conrep : integer) -> + let + !conrep : integer = conrep + in + \(conrep : integer) -> + let + !conrep : integer = conrep + in + Mono conrep conrep + in + \(ds : integer) (ds : integer) -> `$WMono` ds ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoDataType.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoDataType.pir.golden index 1e4be4c34c6..c9ae439f0ec 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoDataType.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoDataType.pir.golden @@ -1,39 +1,19 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind (nonstrict) (vardecl defaultBody (con integer)) (con integer 1)) - (datatypebind - (datatype - (tyvardecl MyMonoData (type)) - - MyMonoData_match - (vardecl Mono (fun (con integer) (fun (con integer) MyMonoData))) - (vardecl Mono (fun (con integer) MyMonoData)) - (vardecl Mono (fun (con integer) MyMonoData)) - ) - ) - (lam + ~defaultBody : integer = 1 + data MyMonoData | MyMonoData_match where + Mono : integer -> integer -> MyMonoData + Mono : integer -> MyMonoData + Mono : integer -> MyMonoData + in + \(ds : MyMonoData) -> + let + !ds : MyMonoData = ds + in + MyMonoData_match ds - MyMonoData - (let - (nonrec) - (termbind (strict) (vardecl ds MyMonoData) ds) - [ - [ - [ - { [ MyMonoData_match ds ] (con integer) } - (lam - default_arg0 - (con integer) - (lam default_arg1 (con integer) defaultBody) - ) - ] - (lam i (con integer) i) - ] - (lam default_arg0 (con integer) defaultBody) - ] - ) - ) - ) -) \ No newline at end of file + {integer} + (\(default_arg0 : integer) (default_arg1 : integer) -> defaultBody) + (\(i : integer) -> i) + (\(default_arg0 : integer) -> defaultBody)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoRecord.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoRecord.pir.golden index 78a3e385301..ee345dd3bef 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoRecord.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/monoRecord.pir.golden @@ -1,24 +1,8 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyMonoRecord (type)) - - MyMonoRecord_match - (vardecl - MyMonoRecord (fun (con integer) (fun (con integer) MyMonoRecord)) - ) - ) - ) - (lam - ds - MyMonoRecord - [ - { [ MyMonoRecord_match ds ] (con integer) } - (lam ipv (con integer) (lam ipv (con integer) ipv)) - ] - ) - ) -) \ No newline at end of file + data MyMonoRecord | MyMonoRecord_match where + MyMonoRecord : integer -> integer -> MyMonoRecord + in + \(ds : MyMonoRecord) -> + MyMonoRecord_match ds {integer} (\(ipv : integer) (ipv : integer) -> ipv)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/nonValueCase.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/nonValueCase.pir.golden index e5218a8e063..051c3b778af 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/nonValueCase.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/nonValueCase.pir.golden @@ -1,46 +1,22 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyEnum (type)) - - MyEnum_match - (vardecl Enum MyEnum) (vardecl Enum MyEnum) - ) - ) - (datatypebind - (datatype (tyvardecl Unit (type)) Unit_match (vardecl Unit Unit)) - ) - (termbind - (strict) - (vardecl error (all a (type) (fun (con unit) a))) - (abs a (type) (lam thunk (con unit) (error a))) - ) - (termbind (strict) (vardecl unitval (con unit)) (con unit ())) - (termbind - (nonstrict) - (vardecl error (all a (type) (fun Unit a))) - (abs a (type) (lam x Unit [ { error a } unitval ])) - ) - (lam + data MyEnum | MyEnum_match where + Enum : MyEnum + Enum : MyEnum + data Unit | Unit_match where + Unit : Unit + !error : all a. unit -> a = /\a -> \(thunk : unit) -> error {a} + !unitval : unit = () + ~error : all a. Unit -> a = /\a -> \(x : Unit) -> error {a} unitval + in + \(ds : MyEnum) -> + let + !ds : MyEnum = ds + in + MyEnum_match ds - MyEnum - (let - (nonrec) - (termbind (strict) (vardecl ds MyEnum) ds) - { - [ - [ - { [ MyEnum_match ds ] (all dead (type) (con integer)) } - (abs dead (type) (con integer 1)) - ] - (abs dead (type) [ { error (con integer) } Unit ]) - ] - (all dead (type) dead) - } - ) - ) - ) -) \ No newline at end of file + {all dead. integer} + (/\dead -> 1) + (/\dead -> error {integer} Unit) + {all dead. dead}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/recordNewtype.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/recordNewtype.pir.golden index 35cfb78d9b0..0594af143c4 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/recordNewtype.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/recordNewtype.pir.golden @@ -1,21 +1,8 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl RecordNewtype (type)) - - RecordNewtype_match - (vardecl RecordNewtype (fun (con integer) RecordNewtype)) - ) - ) - (lam - ds - RecordNewtype - [ - { [ RecordNewtype_match ds ] (con integer) } (lam ipv (con integer) ipv) - ] - ) - ) -) \ No newline at end of file + data RecordNewtype | RecordNewtype_match where + RecordNewtype : integer -> RecordNewtype + in + \(ds : RecordNewtype) -> + RecordNewtype_match ds {integer} (\(ipv : integer) -> ipv)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/recordWithStrictField.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/recordWithStrictField.pir.golden index 5eb4e3ed4ec..d004d0bfa2b 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/recordWithStrictField.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/recordWithStrictField.pir.golden @@ -1,40 +1,20 @@ -(program +program 1.1.0 (let - (nonrec) - (typebind (tyvardecl RecordNewtype (type)) (all a (type) (fun a a))) - (typebind (tyvardecl MyMonoRecord (type)) (all a (type) (fun a a))) - (datatypebind - (datatype - (tyvardecl RecordWithStrictField (type)) - - RecordWithStrictField_match - (vardecl - RecordWithStrictField - (fun MyMonoRecord (fun RecordNewtype RecordWithStrictField)) - ) - ) - ) - (termbind - (nonstrict) - (vardecl strictField (fun RecordWithStrictField RecordNewtype)) - (lam - ds - RecordWithStrictField - [ - { [ RecordWithStrictField_match ds ] RecordNewtype } - (lam ds MyMonoRecord (lam ds RecordNewtype ds)) - ] - ) - ) - (lam - ds - RecordWithStrictField - (let - (nonrec) - (termbind (strict) (vardecl ds RecordWithStrictField) ds) - [ strictField ds ] - ) - ) - ) -) \ No newline at end of file + RecordNewtype = all a. a -> a + MyMonoRecord = all a. a -> a + data RecordWithStrictField | RecordWithStrictField_match where + RecordWithStrictField : + MyMonoRecord -> RecordNewtype -> RecordWithStrictField + ~strictField : RecordWithStrictField -> RecordNewtype + = \(ds : RecordWithStrictField) -> + RecordWithStrictField_match + ds + {RecordNewtype} + (\(ds : MyMonoRecord) (ds : RecordNewtype) -> ds) + in + \(ds : RecordWithStrictField) -> + let + !ds : RecordWithStrictField = ds + in + strictField ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/strictDataMatch.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/strictDataMatch.pir.golden index ab53859bbd9..0941192c29c 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/strictDataMatch.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/strictDataMatch.pir.golden @@ -1,40 +1,18 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl StrictTy (fun (type) (type))) - (tyvardecl a (type)) - StrictTy_match - (vardecl StrictTy (fun a (fun a [ StrictTy a ]))) - ) - ) - (termbind - (nonstrict) - (vardecl `$WStrictTy` (all a (type) (fun a (fun a [ StrictTy a ])))) - (abs - a - (type) - (lam - conrep - a - (let - (nonrec) - (termbind (strict) (vardecl conrep a) conrep) - (lam - conrep - a - (let - (nonrec) - (termbind (strict) (vardecl conrep a) conrep) - [ [ { StrictTy a } conrep ] conrep ] - ) - ) - ) - ) - ) - ) - [ [ { `$WStrictTy` (con integer) } (con integer 1) ] (con integer 2) ] - ) -) \ No newline at end of file + data (StrictTy :: * -> *) a | StrictTy_match where + StrictTy : a -> a -> StrictTy a + ~`$WStrictTy` : all a. a -> a -> StrictTy a + = /\a -> + \(conrep : a) -> + let + !conrep : a = conrep + in + \(conrep : a) -> + let + !conrep : a = conrep + in + StrictTy {a} conrep conrep + in + `$WStrictTy` {integer} 1 2) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/synonym.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/synonym.pir.golden index c897a619d7e..0d9b8af24ca 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/synonym.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/synonym.pir.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 1)) \ No newline at end of file +program 1.1.0 1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/unusedWrapper.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/unusedWrapper.pir.golden index cc60f56b90a..8bddd86f78d 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/unusedWrapper.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/monomorphic/unusedWrapper.pir.golden @@ -1,51 +1,17 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - (datatypebind - (datatype - (tyvardecl T (type)) - - T_match - (vardecl MkT (fun [ [ Tuple2 (con integer) ] (con integer) ] T)) - ) - ) - (termbind - (nonstrict) - (vardecl `$WMkT` (fun [ [ Tuple2 (con integer) ] (con integer) ] T)) - (lam - conrep - [ [ Tuple2 (con integer) ] (con integer) ] - (let - (nonrec) - (termbind - (strict) - (vardecl conrep [ [ Tuple2 (con integer) ] (con integer) ]) - conrep - ) - [ MkT conrep ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl mkT (fun [ [ Tuple2 (con integer) ] (con integer) ] T)) - (lam ds [ [ Tuple2 (con integer) ] (con integer) ] [ `$WMkT` ds ]) - ) - [ - mkT - [ - [ { { Tuple2 (con integer) } (con integer) } (con integer 2) ] - (con integer 1) - ] - ] - ) -) \ No newline at end of file + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + data T | T_match where + MkT : Tuple2 integer integer -> T + ~`$WMkT` : Tuple2 integer integer -> T + = \(conrep : Tuple2 integer integer) -> + let + !conrep : Tuple2 integer integer = conrep + in + MkT conrep + ~mkT : Tuple2 integer integer -> T + = \(ds : Tuple2 integer integer) -> `$WMkT` ds + in + mkT (Tuple2 {integer} {integer} 2 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/basicNewtype.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/basicNewtype.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/basicNewtype.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/basicNewtype.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/nestedNewtypeMatch.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/nestedNewtypeMatch.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/nestedNewtypeMatch.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/nestedNewtypeMatch.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreatDest.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreatDest.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreatDest.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreatDest.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreate.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreate.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreate.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreate.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreate2.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreate2.pir.golden index c897a619d7e..0d9b8af24ca 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreate2.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeCreate2.pir.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 1)) \ No newline at end of file +program 1.1.0 1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeId.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeId.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeId.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeId.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeMatch.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeMatch.pir.golden index 7f9d8a4e60f..5f274561f69 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeMatch.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/newtypeMatch.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con integer) ds)) \ No newline at end of file +program 1.1.0 (\(ds : integer) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/paramNewtype.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/paramNewtype.pir.golden index a54d3cb88ff..e00e4be5105 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/paramNewtype.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/newtypes/paramNewtype.pir.golden @@ -1,29 +1,12 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - (lam - ds - [ (lam a (type) [ Maybe a ]) (con integer) ] - (let - (nonrec) - (termbind (strict) (vardecl nt [ Maybe (con integer) ]) ds) - [ - [ - { [ { Maybe_match (con integer) } nt ] (con integer) } - (lam i (con integer) i) - ] - (con integer 1) - ] - ) - ) - ) -) \ No newline at end of file + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + in + \(ds : (\a -> Maybe a) integer) -> + let + !nt : Maybe integer = ds + in + Maybe_match {integer} nt {integer} (\(i : integer) -> i) 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/defaultCasePoly.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/defaultCasePoly.pir.golden index 5d5764965e7..1e3240608b0 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/defaultCasePoly.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/defaultCasePoly.pir.golden @@ -1,37 +1,18 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyPolyData (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - MyPolyData_match - (vardecl Poly (fun a (fun b [ [ MyPolyData a ] b ]))) - (vardecl Poly (fun a [ [ MyPolyData a ] b ])) - ) - ) - (lam + data (MyPolyData :: * -> * -> *) a b | MyPolyData_match where + Poly : a -> b -> MyPolyData a b + Poly : a -> MyPolyData a b + in + \(ds : MyPolyData integer integer) -> + let + !ds : MyPolyData integer integer = ds + in + MyPolyData_match + {integer} + {integer} ds - [ [ MyPolyData (con integer) ] (con integer) ] - (let - (nonrec) - (termbind - (strict) - (vardecl ds [ [ MyPolyData (con integer) ] (con integer) ]) - ds - ) - [ - [ - { - [ { { MyPolyData_match (con integer) } (con integer) } ds ] - (con integer) - } - (lam a (con integer) (lam ds (con integer) a)) - ] - (lam ipv (con integer) (con integer 2)) - ] - ) - ) - ) -) \ No newline at end of file + {integer} + (\(a : integer) (ds : integer) -> a) + (\(ipv : integer) -> 2)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/polyConstructed.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/polyConstructed.pir.golden index d8fc0bfa72a..d54b5785af9 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/polyConstructed.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/polyConstructed.pir.golden @@ -1,51 +1,19 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyPolyData (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - MyPolyData_match - (vardecl Poly (fun a (fun b [ [ MyPolyData a ] b ]))) - (vardecl Poly (fun a [ [ MyPolyData a ] b ])) - ) - ) - (termbind - (nonstrict) - (vardecl - `$WPoly` - (all a (type) (all b (type) (fun a (fun b [ [ MyPolyData a ] b ])))) - ) - (abs - a - (type) - (abs - b - (type) - (lam - conrep - a - (let - (nonrec) - (termbind (strict) (vardecl conrep a) conrep) - (lam - conrep - b - (let - (nonrec) - (termbind (strict) (vardecl conrep b) conrep) - [ [ { { Poly a } b } conrep ] conrep ] - ) - ) - ) - ) - ) - ) - ) - [ - [ { { `$WPoly` (con integer) } (con integer) } (con integer 1) ] - (con integer 2) - ] - ) -) \ No newline at end of file + data (MyPolyData :: * -> * -> *) a b | MyPolyData_match where + Poly : a -> b -> MyPolyData a b + Poly : a -> MyPolyData a b + ~`$WPoly` : all a b. a -> b -> MyPolyData a b + = /\a b -> + \(conrep : a) -> + let + !conrep : a = conrep + in + \(conrep : b) -> + let + !conrep : b = conrep + in + Poly {a} {b} conrep conrep + in + `$WPoly` {integer} {integer} 1 2) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/polyDataType.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/polyDataType.pir.golden index 28d634e268c..abb1ebca972 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/polyDataType.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/polymorphic/polyDataType.pir.golden @@ -1,37 +1,18 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyPolyData (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - MyPolyData_match - (vardecl Poly (fun a (fun b [ [ MyPolyData a ] b ]))) - (vardecl Poly (fun a [ [ MyPolyData a ] b ])) - ) - ) - (lam + data (MyPolyData :: * -> * -> *) a b | MyPolyData_match where + Poly : a -> b -> MyPolyData a b + Poly : a -> MyPolyData a b + in + \(ds : MyPolyData integer integer) -> + let + !ds : MyPolyData integer integer = ds + in + MyPolyData_match + {integer} + {integer} ds - [ [ MyPolyData (con integer) ] (con integer) ] - (let - (nonrec) - (termbind - (strict) - (vardecl ds [ [ MyPolyData (con integer) ] (con integer) ]) - ds - ) - [ - [ - { - [ { { MyPolyData_match (con integer) } (con integer) } ds ] - (con integer) - } - (lam ipv (con integer) (lam ipv (con integer) (con integer 1))) - ] - (lam i (con integer) i) - ] - ) - ) - ) -) \ No newline at end of file + {integer} + (\(ipv : integer) (ipv : integer) -> 1) + (\(i : integer) -> i)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/interListConstruct.tplc.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/interListConstruct.tplc.golden index f4883bd8476..914194ebc0a 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/interListConstruct.tplc.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/interListConstruct.tplc.golden @@ -1,157 +1,159 @@ -program - 1.1.0 - ((/\Bool -> - \(True : Bool) - (False : Bool) - (Bool_match : - Bool -> (all out_Bool. out_Bool -> out_Bool -> out_Bool)) -> - (/\(InterList :: * -> * -> *) -> - \(InterCons : all a b. a -> b -> InterList b a -> InterList a b) - (InterNil : all a b. InterList a b) - (InterList_match : - all a b. - InterList a b -> - (all out_InterList. - (a -> b -> InterList b a -> out_InterList) -> - out_InterList -> - out_InterList)) -> - InterCons - {integer} - {Bool} - 0 - False - (InterCons - {Bool} - {integer} - False - -1 - (InterCons - {integer} - {Bool} - 42 - True - (InterNil {Bool} {integer})))) - {\a b -> - ifix - (\(rec :: ((* -> * -> *) -> *) -> *) - (spine :: (* -> * -> *) -> *) -> - spine - ((\(InterList :: * -> * -> *) a b -> - sop [a, b, (InterList b a)] []) - (\a b -> rec (\(dat :: * -> * -> *) -> dat a b)))) - (\(dat :: * -> * -> *) -> dat a b)} - (/\a b -> - \(arg_0 : a) - (arg_1 : b) - (arg_2 : - (\a b -> - ifix - (\(rec :: ((* -> * -> *) -> *) -> *) - (spine :: (* -> * -> *) -> *) -> - spine - ((\(InterList :: * -> * -> *) a b -> - sop [a, b, (InterList b a)] []) - (\a b -> rec (\(dat :: * -> * -> *) -> dat a b)))) - (\(dat :: * -> * -> *) -> dat a b)) - b - a) -> - iwrap - (\(rec :: ((* -> * -> *) -> *) -> *) - (spine :: (* -> * -> *) -> *) -> - spine - ((\(InterList :: * -> * -> *) a b -> - sop [a, b, (InterList b a)] []) - (\a b -> rec (\(dat :: * -> * -> *) -> dat a b)))) - (\(dat :: * -> * -> *) -> dat a b) - (constr - (sop - [ a - , b - , ((\a b -> - ifix - (\(rec :: ((* -> * -> *) -> *) -> *) - (spine :: (* -> * -> *) -> *) -> - spine - ((\(InterList :: * -> * -> *) a b -> - sop [a, b, (InterList b a)] []) - (\a b -> - rec - (\(dat :: * -> * -> *) -> - dat a b)))) - (\(dat :: * -> * -> *) -> dat a b)) - b - a) ] - []) - 0 - [arg_0, arg_1, arg_2])) - (/\a b -> - iwrap - (\(rec :: ((* -> * -> *) -> *) -> *) - (spine :: (* -> * -> *) -> *) -> - spine - ((\(InterList :: * -> * -> *) a b -> - sop [a, b, (InterList b a)] []) - (\a b -> rec (\(dat :: * -> * -> *) -> dat a b)))) - (\(dat :: * -> * -> *) -> dat a b) - (constr - (sop - [ a - , b - , ((\a b -> - ifix - (\(rec :: ((* -> * -> *) -> *) -> *) - (spine :: (* -> * -> *) -> *) -> - spine - ((\(InterList :: * -> * -> *) a b -> - sop [a, b, (InterList b a)] []) - (\a b -> - rec - (\(dat :: * -> * -> *) -> dat a b)))) - (\(dat :: * -> * -> *) -> dat a b)) - b - a) ] - []) - 1 - [])) - (/\a b -> - \(x : - (\a b -> - ifix - (\(rec :: ((* -> * -> *) -> *) -> *) - (spine :: (* -> * -> *) -> *) -> - spine - ((\(InterList :: * -> * -> *) a b -> - sop [a, b, (InterList b a)] []) - (\a b -> rec (\(dat :: * -> * -> *) -> dat a b)))) - (\(dat :: * -> * -> *) -> dat a b)) - a - b) -> - /\out_InterList -> - \(case_InterCons : - a -> - b -> - (\a b -> - ifix - (\(rec :: ((* -> * -> *) -> *) -> *) - (spine :: (* -> * -> *) -> *) -> - spine - ((\(InterList :: * -> * -> *) a b -> - sop [a, b, (InterList b a)] []) - (\a b -> - rec (\(dat :: * -> * -> *) -> dat a b)))) - (\(dat :: * -> * -> *) -> dat a b)) - b - a -> - out_InterList) - (case_InterNil : out_InterList) -> - case - out_InterList - (unwrap x) - [case_InterCons, case_InterNil])) - {sop [] []} - (constr (sop [] []) 0 []) - (constr (sop [] []) 1 []) - (\(x : sop [] []) -> - /\out_Bool -> - \(case_True : out_Bool) (case_False : out_Bool) -> - case out_Bool x [case_True, case_False])) \ No newline at end of file +(program + 1.1.0 + ((/\Bool -> + \(True : Bool) + (False : Bool) + (Bool_match : + Bool -> (all out_Bool. out_Bool -> out_Bool -> out_Bool)) -> + (/\(InterList :: * -> * -> *) -> + \(InterCons : all a b. a -> b -> InterList b a -> InterList a b) + (InterNil : all a b. InterList a b) + (InterList_match : + all a b. + InterList a b -> + (all out_InterList. + (a -> b -> InterList b a -> out_InterList) -> + out_InterList -> + out_InterList)) -> + InterCons + {integer} + {Bool} + 0 + False + (InterCons + {Bool} + {integer} + False + -1 + (InterCons + {integer} + {Bool} + 42 + True + (InterNil {Bool} {integer})))) + {\a b -> + ifix + (\(rec :: ((* -> * -> *) -> *) -> *) + (spine :: (* -> * -> *) -> *) -> + spine + ((\(InterList :: * -> * -> *) a b -> + sop [a, b, (InterList b a)] []) + (\a b -> rec (\(dat :: * -> * -> *) -> dat a b)))) + (\(dat :: * -> * -> *) -> dat a b)} + (/\a b -> + \(arg_0 : a) + (arg_1 : b) + (arg_2 : + (\a b -> + ifix + (\(rec :: ((* -> * -> *) -> *) -> *) + (spine :: (* -> * -> *) -> *) -> + spine + ((\(InterList :: * -> * -> *) a b -> + sop [a, b, (InterList b a)] []) + (\a b -> + rec (\(dat :: * -> * -> *) -> dat a b)))) + (\(dat :: * -> * -> *) -> dat a b)) + b + a) -> + iwrap + (\(rec :: ((* -> * -> *) -> *) -> *) + (spine :: (* -> * -> *) -> *) -> + spine + ((\(InterList :: * -> * -> *) a b -> + sop [a, b, (InterList b a)] []) + (\a b -> rec (\(dat :: * -> * -> *) -> dat a b)))) + (\(dat :: * -> * -> *) -> dat a b) + (constr + (sop + [ a + , b + , ((\a b -> + ifix + (\(rec :: ((* -> * -> *) -> *) -> *) + (spine :: (* -> * -> *) -> *) -> + spine + ((\(InterList :: * -> * -> *) a b -> + sop [a, b, (InterList b a)] []) + (\a b -> + rec + (\(dat :: * -> * -> *) -> + dat a b)))) + (\(dat :: * -> * -> *) -> dat a b)) + b + a) ] + []) + 0 + [arg_0, arg_1, arg_2])) + (/\a b -> + iwrap + (\(rec :: ((* -> * -> *) -> *) -> *) + (spine :: (* -> * -> *) -> *) -> + spine + ((\(InterList :: * -> * -> *) a b -> + sop [a, b, (InterList b a)] []) + (\a b -> rec (\(dat :: * -> * -> *) -> dat a b)))) + (\(dat :: * -> * -> *) -> dat a b) + (constr + (sop + [ a + , b + , ((\a b -> + ifix + (\(rec :: ((* -> * -> *) -> *) -> *) + (spine :: (* -> * -> *) -> *) -> + spine + ((\(InterList :: * -> * -> *) a b -> + sop [a, b, (InterList b a)] []) + (\a b -> + rec + (\(dat :: * -> * -> *) -> dat a b)))) + (\(dat :: * -> * -> *) -> dat a b)) + b + a) ] + []) + 1 + [])) + (/\a b -> + \(x : + (\a b -> + ifix + (\(rec :: ((* -> * -> *) -> *) -> *) + (spine :: (* -> * -> *) -> *) -> + spine + ((\(InterList :: * -> * -> *) a b -> + sop [a, b, (InterList b a)] []) + (\a b -> + rec (\(dat :: * -> * -> *) -> dat a b)))) + (\(dat :: * -> * -> *) -> dat a b)) + a + b) -> + /\out_InterList -> + \(case_InterCons : + a -> + b -> + (\a b -> + ifix + (\(rec :: ((* -> * -> *) -> *) -> *) + (spine :: (* -> * -> *) -> *) -> + spine + ((\(InterList :: * -> * -> *) a b -> + sop [a, b, (InterList b a)] []) + (\a b -> + rec (\(dat :: * -> * -> *) -> dat a b)))) + (\(dat :: * -> * -> *) -> dat a b)) + b + a -> + out_InterList) + (case_InterNil : out_InterList) -> + case + out_InterList + (unwrap x) + [case_InterCons, case_InterNil])) + {sop [] []} + (constr (sop [] []) 0 []) + (constr (sop [] []) 1 []) + (\(x : sop [] []) -> + /\out_Bool -> + \(case_True : out_Bool) (case_False : out_Bool) -> + case out_Bool x [case_True, case_False]))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstDest.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstDest.eval.golden index b23026d4762..c227083464f 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstDest.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstDest.eval.golden @@ -1 +1 @@ -(con integer 0) \ No newline at end of file +0 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstDest2.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstDest2.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstDest2.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstDest2.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct.pir.golden index 373ffbb189f..4d4250e84b1 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct.pir.golden @@ -1,16 +1,8 @@ -(program +program 1.1.0 - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - { Nil (con integer) } - ) -) \ No newline at end of file + (letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + Nil {integer}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct2.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct2.pir.golden index 95645eef92d..b3f6e29f3e2 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct2.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct2.pir.golden @@ -1,56 +1,14 @@ -(program +program 1.1.0 - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl - build - (all - a - (type) - (fun (all b (type) (fun (fun a (fun b b)) (fun b b))) [ List a ]) - ) - ) - (abs - a - (type) - (lam - g - (all b (type) (fun (fun a (fun b b)) (fun b b))) - [ - [ - { g [ List a ] } - (lam ds a (lam ds [ List a ] [ [ { Cons a } ds ] ds ])) - ] - { Nil a } - ] - ) - ) - ) - [ - { build (con integer) } - (abs - a - (type) - (lam - c - (fun (con integer) (fun a a)) - (lam n a [ [ c (con integer 1) ] n ]) - ) - ) - ] - ) - ) -) \ No newline at end of file + (letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + ~build : all a. (all b. (a -> b -> b) -> b -> b) -> List a + = /\a -> + \(g : all b. (a -> b -> b) -> b -> b) -> + g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) + in + build {integer} (/\a -> \(c : integer -> a -> a) (n : a) -> c 1 n)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct3.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct3.pir.golden index 14f0aa30b85..c02762ea683 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct3.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listConstruct3.pir.golden @@ -1,22 +1,8 @@ -(program +program 1.1.0 - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - [ - [ { Cons (con integer) } (con integer 1) ] - [ - [ { Cons (con integer) } (con integer 2) ] - [ [ { Cons (con integer) } (con integer 3) ] { Nil (con integer) } ] - ] - ] - ) -) \ No newline at end of file + (letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + Cons {integer} 1 (Cons {integer} 2 (Cons {integer} 3 (Nil {integer})))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listMatch.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listMatch.pir.golden index 18f7b4233f9..487467be406 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listMatch.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/listMatch.pir.golden @@ -1,30 +1,17 @@ -(program +program 1.1.0 - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (lam + (letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + \(ds : List integer) -> + let + !ds : List integer = ds + in + List_match + {integer} ds - [ List (con integer) ] - (let - (nonrec) - (termbind (strict) (vardecl ds [ List (con integer) ]) ds) - [ - [ - { [ { List_match (con integer) } ds ] (con integer) } - (con integer 0) - ] - (lam x (con integer) (lam ds [ List (con integer) ] x)) - ] - ) - ) - ) -) \ No newline at end of file + {integer} + 0 + (\(x : integer) (ds : List integer) -> x)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/polyRecEval.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/polyRecEval.eval.golden index 7ce41fb5eca..e440e5c8425 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/polyRecEval.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/polyRecEval.eval.golden @@ -1 +1 @@ -(con integer 3) \ No newline at end of file +3 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/processInterListEval.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/processInterListEval.eval.golden index 2bfb66d0059..f70d7bba4ae 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/processInterListEval.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/processInterListEval.eval.golden @@ -1 +1 @@ -(con integer 42) \ No newline at end of file +42 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeConstDest.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeConstDest.eval.golden index d135c1204f4..d8263ee9860 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeConstDest.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeConstDest.eval.golden @@ -1 +1 @@ -(con integer 2) \ No newline at end of file +2 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeConstruct.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeConstruct.pir.golden index 9670052f56c..e0a0e9088cc 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeConstruct.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeConstruct.pir.golden @@ -1,100 +1,33 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl B (fun (type) (type))) - (tyvardecl a (type)) - B_match - (vardecl One (fun a [ B a ])) - (vardecl Two (fun [ B [ [ Tuple2 a ] a ] ] [ B a ])) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl `$WOne` (all a (type) (fun a [ B a ]))) - (abs - a - (type) - (lam - conrep - a - (let - (nonrec) - (termbind (strict) (vardecl conrep a) conrep) - [ { One a } conrep ] - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$WTwo` (all a (type) (fun [ B [ [ Tuple2 a ] a ] ] [ B a ])) - ) - (abs - a - (type) - (lam - conrep - [ B [ [ Tuple2 a ] a ] ] - (let - (nonrec) - (termbind - (strict) (vardecl conrep [ B [ [ Tuple2 a ] a ] ]) conrep - ) - [ { Two a } conrep ] - ) - ) - ) - ) - [ - { `$WTwo` (con integer) } - [ - { `$WTwo` [ [ Tuple2 (con integer) ] (con integer) ] } - [ - { - `$WOne` - [ - [ Tuple2 [ [ Tuple2 (con integer) ] (con integer) ] ] - [ [ Tuple2 (con integer) ] (con integer) ] - ] - } - [ - [ - { - { Tuple2 [ [ Tuple2 (con integer) ] (con integer) ] } - [ [ Tuple2 (con integer) ] (con integer) ] - } - [ - [ - { { Tuple2 (con integer) } (con integer) } (con integer 1) - ] - (con integer 2) - ] - ] - [ - [ { { Tuple2 (con integer) } (con integer) } (con integer 3) ] - (con integer 4) - ] - ] - ] - ] - ] - ) - ) - ) -) \ No newline at end of file + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + in + letrec + data (B :: * -> *) a | B_match where + One : a -> B a + Two : B (Tuple2 a a) -> B a + in + let + ~`$WOne` : all a. a -> B a + = /\a -> \(conrep : a) -> let !conrep : a = conrep in One {a} conrep + ~`$WTwo` : all a. B (Tuple2 a a) -> B a + = /\a -> + \(conrep : B (Tuple2 a a)) -> + let + !conrep : B (Tuple2 a a) = conrep + in + Two {a} conrep + in + `$WTwo` + {integer} + (`$WTwo` + {Tuple2 integer integer} + (`$WOne` + {Tuple2 (Tuple2 integer integer) (Tuple2 integer integer)} + (Tuple2 + {Tuple2 integer integer} + {Tuple2 integer integer} + (Tuple2 {integer} {integer} 1 2) + (Tuple2 {integer} {integer} 3 4))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeFirstEval.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeFirstEval.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeFirstEval.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeFirstEval.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeMatch.pir.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeMatch.pir.golden index f13fdbc14c7..9940e5ffaa6 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeMatch.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/ptreeMatch.pir.golden @@ -1,41 +1,20 @@ -(program +program 1.1.0 (let - (nonrec) - (typebind - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (lam a (type) (lam a (type) (all a (type) (fun a a)))) - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl B (fun (type) (type))) - (tyvardecl a (type)) - B_match - (vardecl One (fun a [ B a ])) - (vardecl Two (fun [ B [ [ Tuple2 a ] a ] ] [ B a ])) - ) - ) - (lam - ds - [ B (con integer) ] - (let - (nonrec) - (termbind (strict) (vardecl ds [ B (con integer) ]) ds) - [ - [ - { [ { B_match (con integer) } ds ] (con integer) } - (lam a (con integer) a) - ] - (lam - ds - [ B [ [ Tuple2 (con integer) ] (con integer) ] ] - (con integer 2) - ) - ] - ) - ) - ) - ) -) \ No newline at end of file + Tuple2 :: * -> * -> * = \a a -> all a. a -> a + in + letrec + data (B :: * -> *) a | B_match where + One : a -> B a + Two : B (Tuple2 a a) -> B a + in + \(ds : B integer) -> + let + !ds : B integer = ds + in + B_match + {integer} + ds + {integer} + (\(a : integer) -> a) + (\(ds : B (Tuple2 integer integer)) -> 2)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRose.uplc.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRose.uplc.golden index 5855d08dbd6..b59ff296098 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRose.uplc.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRose.uplc.golden @@ -1,632 +1,177 @@ -(program +program 1.1.0 - [ - (lam - fixBy_i0 - [ - (lam - fix3_i0 - [ - (lam - fix1_i0 - [ - [ - [ - (force + ((\fixBy -> + (\fix3 -> + (\fix1 -> + force + (delay + (\Nil + Cons + List_match -> + force (delay - (lam - Nil_i0 - (lam - Cons_i0 - (lam - List_match_i0 - [ - [ - (force - (delay - (lam - EmptyRose_i0 - (lam - EmptyRose_match_i0 - [ - (lam - g_i0 - [ - (lam - f_i0 - [ - (lam - tup_i0 - [ - (lam - map_i0 - [ - (lam - map_i0 - [ - (lam - tup_i0 - [ - (lam - go_i0 - [ - (lam - g_i0 - [ - (lam - f_i0 - [ - (lam - go_i0 - [ - (lam - g_i0 - [ - (lam - f_i0 - (force - go_i3 - ) - ) - [ - f_i3 - (delay - (lam - x_i0 - x_i1 - ) - ) - ] - ] - ) - [ - g_i3 - (delay - (lam - x_i0 - x_i1 - ) - ) - ] - ] - ) - [ - go_i3 - (delay - (lam - x_i0 - x_i1 - ) - ) - ] - ] - ) - [ - (force - tup_i3 - ) - (lam - arg_0_i0 - (lam - arg_1_i0 - (lam - arg_2_i0 - arg_2_i1 - ) - ) - ) - ] - ] - ) - [ - (force - tup_i2 - ) - (lam - arg_0_i0 - (lam - arg_1_i0 - (lam - arg_2_i0 - arg_1_i2 - ) - ) - ) - ] - ] - ) - [ - (force - tup_i1 - ) - (lam - arg_0_i0 - (lam - arg_1_i0 - (lam - arg_2_i0 - arg_0_i3 - ) - ) - ) - ] - ] - ) - [ - (force - (force - (force - (force - (force - (force - fix3_i12 - ) - ) - ) - ) - ) - ) + (\EmptyRose + EmptyRose_match -> + (\g -> + (\f -> + (\tup -> + (\map -> + (\map -> + (\tup -> + (\go -> + (\g -> + (\f -> + (\go -> + (\g -> + (\f -> force go) + (f (delay - (lam - choose_i0 - (lam - go_i0 - (lam - g_i0 - (lam - f_i0 - [ - [ - [ - choose_i4 - (lam - arg_i0 - (delay - (lam - x_i0 - [ - (lam - x_i0 - [ - (force - g_i12 - ) - [ - (force - [ - f_i4 - (delay - (lam - x_i0 - x_i1 - ) - ) - ] - ) - x_i1 - ] - ] - ) - x_i1 - ] - ) - ) - ) - ] - (lam - arg_i0 - (delay - [ - (force - map_i6 - ) - (force - [ - go_i4 - (delay - (lam - x_i0 - x_i1 - ) - ) - ] - ) - ] - ) - ) - ] - (lam - arg_i0 - (delay - (lam - x_i0 - [ - (lam - x_i0 - [ - (force - [ - g_i5 - (delay - (lam - x_i0 - x_i1 - ) - ) - ] - ) - [ - (force - f_i11 - ) - x_i1 - ] - ] - ) - x_i1 - ] - ) - ) - ) - ] - ) - ) - ) - ) - ) - ] - ] - ) - [ - map_i1 - (delay - (lam x_i0 x_i1) - ) - ] - ] - ) - [ - (force tup_i1) - (lam - arg_0_i0 arg_0_i1 - ) - ] - ] - ) - (delay - (lam - f_i0 - [ - f_i1 - [ - (force - (force fix1_i9) - ) - (lam - map_i0 - (lam - arg_i0 - (delay - (lam - ds_i0 - [ - (lam - ds_i0 - (lam - ds_i0 - (force - [ - [ - (force - [ - (force - List_match_i11 - ) - ds_i1 - ] - ) - (delay - (force - Nil_i13 - ) - ) - ] - (lam - x_i0 - (lam - xs_i0 - (delay - [ - [ - (force - Cons_i14 - ) - [ - ds_i4 - x_i2 - ] - ] - [ - [ - (force - [ - map_i7 - (delay - (lam - x_i0 - x_i1 - ) - ) - ] - ) - ds_i4 - ] - xs_i1 - ] - ] - ) - ) - ) - ] - ) - ) - ) - ds_i1 - ] - ) - ) - ) - ) - ] - ] - ) - ) - ] - ) - (delay - (lam - ds_i0 - [ + (\x -> + x)))) + (g + (delay + (\x -> x)))) + (go (delay (\x -> x)))) + (force tup + (\arg_0 arg_1 arg_2 -> + arg_2))) + (force tup + (\arg_0 arg_1 arg_2 -> + arg_1))) + (force tup + (\arg_0 arg_1 arg_2 -> + arg_0))) + (force + (force + (force (force - [ - EmptyRose_match_i3 - ds_i1 - ] - ) - (lam x_i0 x_i1) - ] - ) - ) - ] - ) - (delay - (lam - ds_i0 - [ - [ - (lam - `$WEmptyRose_i0` - (force `$WEmptyRose_i1`) - ) - (delay - (lam - conrep_i0 - [ - (lam - conrep_i0 - [ - EmptyRose_i5 - conrep_i1 - ] - ) - conrep_i1 - ] - ) - ) - ] - ds_i1 - ] - ) - ) - ] - ) - ) - ) - ) - (lam arg_0_i0 (constr 0 arg_0_i1)) - ] - (lam - x_i0 - (delay - (lam - case_EmptyRose_i0 - (case x_i2 case_EmptyRose_i1) - ) - ) - ) - ] - ) - ) - ) - ) - ) - (delay (constr 0)) - ] - (delay - (lam arg_0_i0 (lam arg_1_i0 (constr 1 arg_0_i2 arg_1_i1))) - ) - ] - (delay - (lam - x_i0 - (delay - (lam - case_Nil_i0 - (lam case_Cons_i0 (case x_i3 case_Nil_i2 case_Cons_i1)) - ) - ) - ) - ) - ] - ) - (delay + (force (force fix3))))) + (delay + (\choose + go + g + f -> + choose + (\arg -> + delay + (\x -> + (\x -> + force + g + (force + (f + (delay + (\x -> + x))) + x)) + x)) + (\arg -> + delay + (force + map + (force + (go + (delay + (\x -> + x)))))) + (\arg -> + delay + (\x -> + (\x -> + force + (g + (delay + (\x -> + x))) + (force f + x)) + x)))))) + (map (delay (\x -> x)))) + (force tup (\arg_0 -> arg_0))) + (delay + (\f -> + f + (force + (force fix1) + (\map + arg -> + delay + (\ds -> + (\ds + ds -> + force + (force + (force List_match + ds) + (delay + (force Nil)) + (\x + xs -> + delay + (force + Cons + (ds x) + (force + (map + (delay + (\x -> + x))) + ds + xs))))) + ds)))))) + (delay + (\ds -> + force (EmptyRose_match ds) (\x -> x)))) + (delay + (\ds -> + (\`$WEmptyRose` -> force `$WEmptyRose`) + (delay + (\conrep -> + (\conrep -> EmptyRose conrep) + conrep)) + ds)))) + (\arg_0 -> constr 0 [arg_0]) + (\x -> + delay (\case_EmptyRose -> case x [case_EmptyRose])))) + (delay (constr 0 [])) + (delay (\arg_0 arg_1 -> constr 1 [arg_0, arg_1])) (delay - (lam - f_i0 - [ - (force (delay (lam s_i0 [ s_i1 s_i1 ]))) - (lam - s_i0 - [ - f_i2 - (lam - x_i0 - [ - [ (force (delay (lam s_i0 [ s_i1 s_i1 ]))) s_i2 ] - x_i1 - ] - ) - ] - ) - ] - ) - ) - ) - ] - ) - (delay - (delay - (delay + (\x -> + delay + (\case_Nil case_Cons -> case x [case_Nil, case_Cons])))) + (delay (delay - (delay - (delay - (lam - f_i0 - [ - [ - (force fixBy_i2) - (lam - k_i0 - (delay - (lam - h_i0 - [ - [ - [ - h_i1 - (lam - x_i0 - [ - (force k_i3) - (lam - f_0_i0 - (lam - f_1_i0 - (lam f_2_i0 [ f_0_i3 x_i4 ]) - ) - ) - ] - ) - ] - (lam - x_i0 - [ - (force k_i3) - (lam - f_0_i0 - (lam - f_1_i0 (lam f_2_i0 [ f_1_i2 x_i4 ]) - ) - ) - ] - ) - ] - (lam - x_i0 - [ - (force k_i3) - (lam - f_0_i0 - (lam - f_1_i0 (lam f_2_i0 [ f_2_i1 x_i4 ]) - ) - ) - ] - ) - ] - ) - ) - ) - ] - f_i1 - ] - ) - ) - ) - ) - ) - ) - ) - ] - ) - (delay - (lam - by_i0 - [ - (force - (force + (\f -> + force (delay (\s -> s s)) + (\s -> f (\x -> force (delay (\s -> s s)) s x)))))) + (delay + (delay (delay + (delay + (delay + (delay + (\f -> + force fixBy + (\k -> + delay + (\h -> + h + (\x -> force k (\f_0 f_1 f_2 -> f_0 x)) + (\x -> force k (\f_0 f_1 f_2 -> f_1 x)) + (\x -> + force k (\f_0 f_1 f_2 -> f_2 x)))) + f)))))))) + (delay + (\by -> + force + (force (delay - (lam - f_i0 - [ - (force (delay (lam s_i0 [ s_i1 s_i1 ]))) - (lam - s_i0 - [ - f_i2 - (lam - x_i0 - [ - [ (force (delay (lam s_i0 [ s_i1 s_i1 ]))) s_i2 ] - x_i1 - ] - ) - ] - ) - ] - ) - ) - ) - ) - ) - (lam - rec_i0 - (lam - h_i0 - (delay - (lam - fr_i0 - [ - (force - [ - by_i4 - (delay - (lam - fq_i0 - [ (force [ rec_i4 h_i3 ]) [ (force h_i3) fq_i1 ] ] - ) - ) - ] - ) - fr_i1 - ] - ) - ) - ) - ) - ] - ) - ) - ] -) \ No newline at end of file + (delay + (\f -> + force (delay (\s -> s s)) + (\s -> f (\x -> force (delay (\s -> s s)) s x)))))) + (\rec h -> + delay + (\fr -> + force (by (delay (\fq -> force (rec h) (force h fq)))) + fr))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRoseEval.eval.golden b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRoseEval.eval.golden index d485f0229df..e665e731059 100644 --- a/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRoseEval.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Data/9.6/recursive/sameEmptyRoseEval.eval.golden @@ -1,3 +1,4 @@ -(constr - 0 (constr 1 (constr 0 (constr 0)) (constr 1 (constr 0 (constr 0)) (constr 0))) -) \ No newline at end of file +constr 0 + [ (constr 1 + [ (constr 0 [(constr 0 [])]) + , (constr 1 [(constr 0 [(constr 0 [])]), (constr 0 [])]) ]) ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden index 45afefbea79..7be80da7b1c 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/fib.pir.golden @@ -9,7 +9,7 @@ (strict) (vardecl { no-src-span } - addInteger + addInteger-538 (fun { no-src-span } (con { no-src-span } integer) @@ -27,7 +27,7 @@ (nonstrict) (vardecl { no-src-span } - addInteger + addInteger-543 (fun { no-src-span } (con { no-src-span } integer) @@ -40,7 +40,7 @@ ) (lam { no-src-span } - x + x-539 (con { no-src-span } integer) (let { no-src-span } @@ -48,12 +48,12 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } x (con { no-src-span } integer)) - { no-src-span } x + (vardecl { no-src-span } x-541 (con { no-src-span } integer)) + { no-src-span } x-539 ) (lam { no-src-span } - y + y-540 (con { no-src-span } integer) (let { no-src-span } @@ -61,13 +61,17 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } y (con { no-src-span } integer)) - { no-src-span } y + (vardecl { no-src-span } y-542 (con { no-src-span } integer)) + { no-src-span } y-540 ) [ { no-src-span } - [ { no-src-span } { no-src-span } addInteger { no-src-span } x ] - { no-src-span } y + [ + { no-src-span } + { no-src-span } addInteger-538 + { no-src-span } x-541 + ] + { no-src-span } y-542 ] ) ) @@ -78,11 +82,11 @@ { no-src-span } (datatype { no-src-span } - (tyvardecl { no-src-span } Bool ({ no-src-span } type)) + (tyvardecl { no-src-span } Bool-528 ({ no-src-span } type)) - Bool_match - (vardecl { no-src-span } True { no-src-span } Bool) - (vardecl { no-src-span } False { no-src-span } Bool) + Bool_match-531 + (vardecl { no-src-span } True-529 { no-src-span } Bool-528) + (vardecl { no-src-span } False-530 { no-src-span } Bool-528) ) ) (termbind @@ -90,7 +94,7 @@ (strict) (vardecl { no-src-span } - equalsInteger + equalsInteger-527 (fun { no-src-span } (con { no-src-span } integer) @@ -108,18 +112,18 @@ (strict) (vardecl { no-src-span } - ifThenElse + ifThenElse-525 (all { no-src-span } - a + a-526 ({ no-src-span } type) (fun { no-src-span } (con { no-src-span } bool) (fun { no-src-span } - { no-src-span } a - (fun { no-src-span } { no-src-span } a { no-src-span } a) + { no-src-span } a-526 + (fun { no-src-span } { no-src-span } a-526 { no-src-span } a-526) ) ) ) @@ -131,18 +135,20 @@ (nonstrict) (vardecl { no-src-span } - equalsInteger + equalsInteger-537 (fun { no-src-span } (con { no-src-span } integer) (fun - { no-src-span } (con { no-src-span } integer) { no-src-span } Bool + { no-src-span } + (con { no-src-span } integer) + { no-src-span } Bool-528 ) ) ) (lam { no-src-span } - x + x-532 (con { no-src-span } integer) (let { no-src-span } @@ -150,12 +156,12 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } x (con { no-src-span } integer)) - { no-src-span } x + (vardecl { no-src-span } x-534 (con { no-src-span } integer)) + { no-src-span } x-532 ) (lam { no-src-span } - y + y-533 (con { no-src-span } integer) (let { no-src-span } @@ -163,21 +169,21 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } y (con { no-src-span } integer)) - { no-src-span } y + (vardecl { no-src-span } y-535 (con { no-src-span } integer)) + { no-src-span } y-533 ) (termbind { no-src-span } (strict) - (vardecl { no-src-span } b (con { no-src-span } bool)) + (vardecl { no-src-span } b-536 (con { no-src-span } bool)) [ { no-src-span } [ { no-src-span } - { no-src-span } equalsInteger - { no-src-span } x + { no-src-span } equalsInteger-527 + { no-src-span } x-534 ] - { no-src-span } y + { no-src-span } y-535 ] ) [ @@ -188,14 +194,14 @@ { no-src-span } { { no-src-span } - { no-src-span } ifThenElse - { no-src-span } Bool + { no-src-span } ifThenElse-525 + { no-src-span } Bool-528 } - { no-src-span } b + { no-src-span } b-536 ] - { no-src-span } True + { no-src-span } True-529 ] - { no-src-span } False + { no-src-span } False-530 ] ) ) @@ -207,7 +213,7 @@ (strict) (vardecl { no-src-span } - subtractInteger + subtractInteger-519 (fun { no-src-span } (con { no-src-span } integer) @@ -225,7 +231,7 @@ (nonstrict) (vardecl { no-src-span } - subtractInteger + subtractInteger-524 (fun { no-src-span } (con { no-src-span } integer) @@ -238,7 +244,7 @@ ) (lam { no-src-span } - x + x-520 (con { no-src-span } integer) (let { no-src-span } @@ -246,12 +252,12 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } x (con { no-src-span } integer)) - { no-src-span } x + (vardecl { no-src-span } x-522 (con { no-src-span } integer)) + { no-src-span } x-520 ) (lam { no-src-span } - y + y-521 (con { no-src-span } integer) (let { no-src-span } @@ -259,17 +265,17 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } y (con { no-src-span } integer)) - { no-src-span } y + (vardecl { no-src-span } y-523 (con { no-src-span } integer)) + { no-src-span } y-521 ) [ { no-src-span } [ { no-src-span } - { no-src-span } subtractInteger - { no-src-span } x + { no-src-span } subtractInteger-519 + { no-src-span } x-522 ] - { no-src-span } y + { no-src-span } y-523 ] ) ) @@ -284,7 +290,7 @@ (nonstrict) (vardecl { no-src-span } - fib + fib-544 (fun { no-src-span } (con { no-src-span } integer) @@ -293,7 +299,7 @@ ) (lam { no-src-span } - n + n-545 (con { no-src-span } integer) (let { test/Plugin/Debug/Spec.hs:46:15-55:72 } @@ -303,10 +309,10 @@ (strict) (vardecl { test/Plugin/Debug/Spec.hs:46:15-55:72 } - n + n-546 (con { test/Plugin/Debug/Spec.hs:46:15-55:72 } integer) ) - { test/Plugin/Debug/Spec.hs:46:15-55:72 } n + { test/Plugin/Debug/Spec.hs:46:15-55:72 } n-545 ) { { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } @@ -319,15 +325,15 @@ [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - Bool_match + Bool_match-531 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - equalsInteger + equalsInteger-537 { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:47:43-47:43 } - n + n-546 ] (con { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:47:45-47:45 } @@ -338,7 +344,7 @@ ] (all { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead + dead-547 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) (con @@ -349,7 +355,7 @@ } (abs { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead + dead-548 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) (con @@ -361,7 +367,7 @@ ] (abs { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead + dead-549 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) { @@ -375,15 +381,15 @@ [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - Bool_match + Bool_match-531 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - equalsInteger + equalsInteger-537 { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:50:51-50:51 } - n + n-546 ] (con { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:50:53-50:53 } @@ -394,7 +400,7 @@ ] (all { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead + dead-550 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) (con @@ -405,7 +411,7 @@ } (abs { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead + dead-551 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) (con @@ -417,7 +423,7 @@ ] (abs { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead + dead-552 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) [ @@ -425,19 +431,19 @@ [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72 } - addInteger + addInteger-543 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72 } - fib + fib-544 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71 } - subtractInteger + subtractInteger-524 { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71, test/Plugin/Debug/Spec.hs:54:68-54:68 } - n + n-546 ] (con { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:54:37-54:72, test/Plugin/Debug/Spec.hs:54:42-54:71, test/Plugin/Debug/Spec.hs:54:70-54:70 } @@ -450,15 +456,15 @@ [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72 } - fib + fib-544 [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } [ { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71 } - subtractInteger + subtractInteger-524 { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71, test/Plugin/Debug/Spec.hs:55:68-55:68 } - n + n-546 ] (con { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72, test/Plugin/Debug/Spec.hs:53:33-55:72, test/Plugin/Debug/Spec.hs:55:37-55:72, test/Plugin/Debug/Spec.hs:55:42-55:71, test/Plugin/Debug/Spec.hs:55:70-55:70 } @@ -472,28 +478,28 @@ ] (all { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead + dead-553 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } type) { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72, test/Plugin/Debug/Spec.hs:50:25-55:72 } - dead + dead-553 ) } ) ] (all { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead + dead-554 ({ test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } type) { test/Plugin/Debug/Spec.hs:46:15-55:72, test/Plugin/Debug/Spec.hs:47:17-55:72 } - dead + dead-554 ) } ) ) ) - { test/Plugin/Debug/Spec.hs:45:9-57:9 } fib + { test/Plugin/Debug/Spec.hs:45:9-57:9 } fib-544 ) ) ) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden index 4c61eb0073f..e3ff78c1481 100644 --- a/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Debug/9.6/letFun.pir.golden @@ -8,11 +8,11 @@ { no-src-span } (datatype { no-src-span } - (tyvardecl { no-src-span } Bool ({ no-src-span } type)) + (tyvardecl { no-src-span } Bool-445 ({ no-src-span } type)) - Bool_match - (vardecl { no-src-span } True { no-src-span } Bool) - (vardecl { no-src-span } False { no-src-span } Bool) + Bool_match-448 + (vardecl { no-src-span } True-446 { no-src-span } Bool-445) + (vardecl { no-src-span } False-447 { no-src-span } Bool-445) ) ) (termbind @@ -20,7 +20,7 @@ (strict) (vardecl { no-src-span } - equalsInteger + equalsInteger-444 (fun { no-src-span } (con { no-src-span } integer) @@ -38,18 +38,18 @@ (strict) (vardecl { no-src-span } - ifThenElse + ifThenElse-442 (all { no-src-span } - a + a-443 ({ no-src-span } type) (fun { no-src-span } (con { no-src-span } bool) (fun { no-src-span } - { no-src-span } a - (fun { no-src-span } { no-src-span } a { no-src-span } a) + { no-src-span } a-443 + (fun { no-src-span } { no-src-span } a-443 { no-src-span } a-443) ) ) ) @@ -61,18 +61,20 @@ (nonstrict) (vardecl { no-src-span } - equalsInteger + equalsInteger-454 (fun { no-src-span } (con { no-src-span } integer) (fun - { no-src-span } (con { no-src-span } integer) { no-src-span } Bool + { no-src-span } + (con { no-src-span } integer) + { no-src-span } Bool-445 ) ) ) (lam { no-src-span } - x + x-449 (con { no-src-span } integer) (let { no-src-span } @@ -80,12 +82,12 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } x (con { no-src-span } integer)) - { no-src-span } x + (vardecl { no-src-span } x-451 (con { no-src-span } integer)) + { no-src-span } x-449 ) (lam { no-src-span } - y + y-450 (con { no-src-span } integer) (let { no-src-span } @@ -93,21 +95,21 @@ (termbind { no-src-span } (strict) - (vardecl { no-src-span } y (con { no-src-span } integer)) - { no-src-span } y + (vardecl { no-src-span } y-452 (con { no-src-span } integer)) + { no-src-span } y-450 ) (termbind { no-src-span } (strict) - (vardecl { no-src-span } b (con { no-src-span } bool)) + (vardecl { no-src-span } b-453 (con { no-src-span } bool)) [ { no-src-span } [ { no-src-span } - { no-src-span } equalsInteger - { no-src-span } x + { no-src-span } equalsInteger-444 + { no-src-span } x-451 ] - { no-src-span } y + { no-src-span } y-452 ] ) [ @@ -118,14 +120,14 @@ { no-src-span } { { no-src-span } - { no-src-span } ifThenElse - { no-src-span } Bool + { no-src-span } ifThenElse-442 + { no-src-span } Bool-445 } - { no-src-span } b + { no-src-span } b-453 ] - { no-src-span } True + { no-src-span } True-446 ] - { no-src-span } False + { no-src-span } False-447 ] ) ) @@ -134,7 +136,7 @@ ) (lam { no-src-span } - ds + ds-455 (con { no-src-span } integer) (let { test/Plugin/Debug/Spec.hs:38:9-38:87 } @@ -144,14 +146,14 @@ (strict) (vardecl { test/Plugin/Debug/Spec.hs:38:9-38:87 } - ds + ds-457 (con { test/Plugin/Debug/Spec.hs:38:9-38:87 } integer) ) - { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds + { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds-455 ) (lam { no-src-span } - ds + ds-456 (con { no-src-span } integer) (let { test/Plugin/Debug/Spec.hs:38:9-38:87 } @@ -161,22 +163,22 @@ (strict) (vardecl { test/Plugin/Debug/Spec.hs:38:9-38:87 } - ds + ds-458 (con { test/Plugin/Debug/Spec.hs:38:9-38:87 } integer) ) - { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds + { test/Plugin/Debug/Spec.hs:38:9-38:87 } ds-456 ) [ { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } [ { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79 } - equalsInteger + equalsInteger-454 { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79, test/Plugin/Debug/Spec.hs:38:77-38:77 } - ds + ds-457 ] { test/Plugin/Debug/Spec.hs:38:9-38:87, test/Plugin/Debug/Spec.hs:38:44-38:86, test/Plugin/Debug/Spec.hs:38:54-38:79, test/Plugin/Debug/Spec.hs:38:79-38:79 } - ds + ds-458 ] ) ) diff --git a/plutus-tx-plugin/test/Plugin/Errors/9.6/literalAppendBs.uplc.golden b/plutus-tx-plugin/test/Plugin/Errors/9.6/literalAppendBs.uplc.golden index e486156dc3b..a68c541e0fc 100644 --- a/plutus-tx-plugin/test/Plugin/Errors/9.6/literalAppendBs.uplc.golden +++ b/plutus-tx-plugin/test/Plugin/Errors/9.6/literalAppendBs.uplc.golden @@ -1,27 +1,9 @@ -(program +program 1.1.0 - (lam - x_i0 - [ - (lam - x_i0 - [ - [ - [ - (lam appendByteString_i0 (force appendByteString_i1)) - (delay - [ - (lam appendByteString_i0 appendByteString_i1) - (builtin appendByteString) - ] - ) - ] - (con bytestring #68656c6c6f) - ] - x_i1 - ] - ) - x_i1 - ] - ) -) \ No newline at end of file + (\x -> + (\x -> + (\appendByteString -> force appendByteString) + (delay ((\appendByteString -> appendByteString) appendByteString)) + #68656c6c6f + x) + x) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden index ca4884de89c..6fddca8c052 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even.pir.golden @@ -1,137 +1,50 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl - subtractInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin subtractInteger) - ) - (termbind - (nonstrict) - (vardecl - subtractInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ subtractInteger x ] y ] - ) - ) - ) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl even (fun (con integer) Bool)) - (lam - n - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl n (con integer)) n) - { - [ - [ - { - [ Bool_match [ [ equalsInteger n ] (con integer 0) ] ] - (all dead (type) Bool) - } - (abs dead (type) True) - ] - (abs - dead - (type) - (let - (nonrec) - (termbind - (strict) - (vardecl n (con integer)) - [ [ subtractInteger n ] (con integer 1) ] - ) - { - [ - [ - { - [ - Bool_match [ [ equalsInteger n ] (con integer 0) ] - ] - (all dead (type) Bool) - } - (abs dead (type) False) - ] - (abs - dead - (type) - [ even [ [ subtractInteger n ] (con integer 1) ] ] - ) - ] - (all dead (type) dead) - } - ) - ) - ] - (all dead (type) dead) - } - ) - ) - ) - even - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + !subtractInteger : integer -> integer -> integer = subtractInteger + ~subtractInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in subtractInteger x y + in + letrec + ~even : integer -> Bool + = \(n : integer) -> + let + !n : integer = n + in + Bool_match + (equalsInteger n 0) + {all dead. Bool} + (/\dead -> True) + (/\dead -> + let + !n : integer = subtractInteger n 1 + in + Bool_match + (equalsInteger n 0) + {all dead. Bool} + (/\dead -> False) + (/\dead -> even (subtractInteger n 1)) + {all dead. dead}) + {all dead. dead} + in + even) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even3.eval.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even3.eval.golden index f217693e82c..3a05a39aa43 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even3.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even3.eval.golden @@ -1 +1 @@ -(constr 1) \ No newline at end of file +constr 1 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even4.eval.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even4.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even4.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/even4.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden index 0c8019e7afb..f4e7e9b6b50 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib.pir.golden @@ -1,159 +1,57 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl - subtractInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin subtractInteger) - ) - (termbind - (nonstrict) - (vardecl - subtractInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ subtractInteger x ] y ] - ) - ) - ) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl fib (fun (con integer) (con integer))) - (lam - n - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl n (con integer)) n) - { - [ - [ - { - [ Bool_match [ [ equalsInteger n ] (con integer 0) ] ] - (all dead (type) (con integer)) - } - (abs dead (type) (con integer 0)) - ] - (abs - dead - (type) - { - [ - [ - { - [ Bool_match [ [ equalsInteger n ] (con integer 1) ] ] - (all dead (type) (con integer)) - } - (abs dead (type) (con integer 1)) - ] - (abs - dead - (type) - [ - [ - addInteger - [ fib [ [ subtractInteger n ] (con integer 1) ] ] - ] - [ fib [ [ subtractInteger n ] (con integer 2) ] ] - ] - ) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ) - ) - ) - fib - ) - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + data Bool | Bool_match where + True : Bool + False : Bool + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + !subtractInteger : integer -> integer -> integer = subtractInteger + ~subtractInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in subtractInteger x y + in + letrec + ~fib : integer -> integer + = \(n : integer) -> + let + !n : integer = n + in + Bool_match + (equalsInteger n 0) + {all dead. integer} + (/\dead -> 0) + (/\dead -> + Bool_match + (equalsInteger n 1) + {all dead. integer} + (/\dead -> 1) + (/\dead -> + addInteger + (fib (subtractInteger n 1)) + (fib (subtractInteger n 2))) + {all dead. dead}) + {all dead. dead} + in + fib) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib4.eval.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib4.eval.golden index 7ce41fb5eca..e440e5c8425 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib4.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/fib4.eval.golden @@ -1 +1 @@ -(con integer 3) \ No newline at end of file +3 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/lazyLength.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/lazyLength.pir.golden index 969e4c7594e..be60946322f 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/lazyLength.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/lazyLength.pir.golden @@ -1,112 +1,36 @@ -(program +program 1.1.0 - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl - addInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl - addInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl lengthLazy (all a (type) (fun [ List a ] (con integer)))) - (abs - a - (type) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun (con integer) (fun [ List a ] (con integer)))) - (lam - acc - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl acc (con integer)) acc) - (lam - ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] - (all dead (type) (con integer)) - } - (abs dead (type) acc) - ] - (lam - ds - a - (lam - tl - [ List a ] - (abs - dead - (type) - [ - [ go [ [ addInteger acc ] (con integer 1) ] ] tl - ] - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - (lam - l - [ List a ] - (let - (nonrec) - (termbind (strict) (vardecl l [ List a ]) l) - [ [ go (con integer 0) ] l ] - ) - ) - ) - ) - ) - { lengthLazy (con integer) } - ) - ) -) \ No newline at end of file + (letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~lengthLazy : all a. List a -> integer + = /\a -> + letrec + ~go : integer -> List a -> integer + = \(acc : integer) -> + let + !acc : integer = acc + in + \(ds : List a) -> + List_match + {a} + ds + {all dead. integer} + (/\dead -> acc) + (\(ds : a) (tl : List a) -> + /\dead -> go (addInteger acc 1) tl) + {all dead. dead} + in + \(l : List a) -> let !l : List a = l in go 0 l + in + lengthLazy {integer}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/strictLength.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/strictLength.pir.golden index 46bef8adf77..1eb6e93fa0c 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/strictLength.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/strictLength.pir.golden @@ -1,112 +1,36 @@ -(program +program 1.1.0 - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl - addInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl - addInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl lengthStrict (all a (type) (fun [ List a ] (con integer)))) - (abs - a - (type) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun (con integer) (fun [ List a ] (con integer)))) - (lam - acc - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl acc (con integer)) acc) - (lam - ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] - (all dead (type) (con integer)) - } - (abs dead (type) acc) - ] - (lam - ds - a - (lam - tl - [ List a ] - (abs - dead - (type) - [ - [ go [ [ addInteger acc ] (con integer 1) ] ] tl - ] - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - (lam - l - [ List a ] - (let - (nonrec) - (termbind (strict) (vardecl l [ List a ]) l) - [ [ go (con integer 0) ] l ] - ) - ) - ) - ) - ) - { lengthStrict (con integer) } - ) - ) -) \ No newline at end of file + (letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~lengthStrict : all a. List a -> integer + = /\a -> + letrec + ~go : integer -> List a -> integer + = \(acc : integer) -> + let + !acc : integer = acc + in + \(ds : List a) -> + List_match + {a} + ds + {all dead. integer} + (/\dead -> acc) + (\(ds : a) (tl : List a) -> + /\dead -> go (addInteger acc 1) tl) + {all dead. dead} + in + \(l : List a) -> let !l : List a = l in go 0 l + in + lengthStrict {integer}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/sum.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/sum.pir.golden index c2956ba9812..410b408a430 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/sum.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/sum.pir.golden @@ -1,71 +1,27 @@ -(program +program 1.1.0 - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (strict) - (vardecl - addInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl - addInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl sum (fun [ List (con integer) ] (con integer))) - (lam + (letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + letrec + ~sum : List integer -> integer + = \(ds : List integer) -> + List_match + {integer} ds - [ List (con integer) ] - [ - [ - { [ { List_match (con integer) } ds ] (con integer) } - (con integer 0) - ] - (lam - x - (con integer) - (lam xs [ List (con integer) ] [ [ addInteger x ] [ sum xs ] ]) - ) - ] - ) - ) - sum - ) - ) - ) -) \ No newline at end of file + {integer} + 0 + (\(x : integer) (xs : List integer) -> addInteger x (sum xs)) + in + sum) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/sumList.eval.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/sumList.eval.golden index 96d17867bdd..62f9457511f 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/sumList.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/recursive/sumList.eval.golden @@ -1 +1 @@ -(con integer 6) \ No newline at end of file +6 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden index 3339158e114..4dc4e539e4b 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/allDirect.pir.golden @@ -1,247 +1,86 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (nonstrict) - (vardecl nandDirect (fun Bool (fun Bool Bool))) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - { - [ - [ - { [ Bool_match ds ] (all dead (type) Bool) } - (abs dead (type) False) - ] - (abs - dead - (type) - { - [ - [ - { [ Bool_match ds ] (all dead (type) Bool) } - (abs dead (type) False) - ] - (abs dead (type) True) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl andDirect (fun Bool (fun Bool Bool))) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - [ - [ nandDirect [ [ nandDirect ds ] ds ] ] [ [ nandDirect ds ] ds ] - ] - ) - ) - ) - ) - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl - allDirect (all a (type) (fun (fun a Bool) (fun [ List a ] Bool))) - ) - (abs - a - (type) - (lam - p - (fun a Bool) - (let - (nonrec) - (termbind (strict) (vardecl p (fun a Bool)) p) - (lam - l - [ List a ] - (let - (nonrec) - (termbind (strict) (vardecl l [ List a ]) l) - { - [ - [ - { [ { List_match a } l ] (all dead (type) Bool) } - (abs dead (type) True) - ] - (lam - h - a - (lam - t - [ List a ] - (abs - dead - (type) - [ - [ andDirect [ p h ] ] - [ [ { allDirect a } p ] t ] - ] - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl - build - (all - a - (type) - (fun - (all b (type) (fun (fun a (fun b b)) (fun b b))) [ List a ] - ) - ) - ) - (abs - a - (type) - (lam - g - (all b (type) (fun (fun a (fun b b)) (fun b b))) - [ - [ - { g [ List a ] } - (lam ds a (lam ds [ List a ] [ [ { Cons a } ds ] ds ])) - ] - { Nil a } - ] - ) - ) - ) - (termbind - (strict) - (vardecl - ifThenElse (all a (type) (fun (con bool) (fun a (fun a a)))) - ) - (builtin ifThenElse) - ) - (termbind - (strict) - (vardecl - lessThanInteger (fun (con integer) (fun (con integer) (con bool))) - ) - (builtin lessThanInteger) - ) - (termbind - (nonstrict) - (vardecl - lessThanInteger (fun (con integer) (fun (con integer) Bool)) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) - (vardecl b (con bool)) - [ [ lessThanInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - [ - [ - { allDirect (con integer) } - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ [ lessThanInteger ds ] (con integer 5) ] - ) - ) - ] - [ - { build (con integer) } - (abs - a - (type) - (lam - c - (fun (con integer) (fun a a)) - (lam - n a [ [ c (con integer 7) ] [ [ c (con integer 6) ] n ] ] - ) - ) - ) - ] - ] - ) - ) - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + ~nandDirect : Bool -> Bool -> Bool + = \(ds : Bool) -> + let + !ds : Bool = ds + in + \(ds : Bool) -> + let + !ds : Bool = ds + in + Bool_match + ds + {all dead. Bool} + (/\dead -> False) + (/\dead -> + Bool_match + ds + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + {all dead. dead} + ~andDirect : Bool -> Bool -> Bool + = \(ds : Bool) -> + let + !ds : Bool = ds + in + \(ds : Bool) -> + let + !ds : Bool = ds + in + nandDirect (nandDirect ds ds) (nandDirect ds ds) + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + letrec + ~allDirect : all a. (a -> Bool) -> List a -> Bool + = /\a -> + \(p : a -> Bool) -> + let + !p : a -> Bool = p + in + \(l : List a) -> + let + !l : List a = l + in + List_match + {a} + l + {all dead. Bool} + (/\dead -> True) + (\(h : a) (t : List a) -> + /\dead -> andDirect (p h) (allDirect {a} p t)) + {all dead. dead} + in + let + ~build : all a. (all b. (a -> b -> b) -> b -> b) -> List a + = /\a -> + \(g : all b. (a -> b -> b) -> b -> b) -> + g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !lessThanInteger : integer -> integer -> bool = lessThanInteger + ~lessThanInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = lessThanInteger x y + in + ifThenElse {Bool} b True False + in + allDirect + {integer} + (\(ds : integer) -> let !ds : integer = ds in lessThanInteger ds 5) + (build {integer} (/\a -> \(c : integer -> a -> a) (n : a) -> c 7 (c 6 n)))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/andDirect.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/andDirect.pir.golden index 7e014377ae0..d4692d0424c 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/andDirect.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/andDirect.pir.golden @@ -1,81 +1,39 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (nonstrict) - (vardecl nandDirect (fun Bool (fun Bool Bool))) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - { - [ - [ - { [ Bool_match ds ] (all dead (type) Bool) } - (abs dead (type) False) - ] - (abs - dead - (type) - { - [ - [ - { [ Bool_match ds ] (all dead (type) Bool) } - (abs dead (type) False) - ] - (abs dead (type) True) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl andDirect (fun Bool (fun Bool Bool))) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - [ - [ nandDirect [ [ nandDirect ds ] ds ] ] [ [ nandDirect ds ] ds ] - ] - ) - ) - ) - ) - ) - [ [ andDirect True ] False ] - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + ~nandDirect : Bool -> Bool -> Bool + = \(ds : Bool) -> + let + !ds : Bool = ds + in + \(ds : Bool) -> + let + !ds : Bool = ds + in + Bool_match + ds + {all dead. Bool} + (/\dead -> False) + (/\dead -> + Bool_match + ds + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + {all dead. dead} + ~andDirect : Bool -> Bool -> Bool + = \(ds : Bool) -> + let + !ds : Bool = ds + in + \(ds : Bool) -> + let + !ds : Bool = ds + in + nandDirect (nandDirect ds ds) (nandDirect ds ds) + in + andDirect True False) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/andExternal.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/andExternal.pir.golden index 724509fc76d..e8e63e81cad 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/andExternal.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/andExternal.pir.golden @@ -1,45 +1,23 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (nonstrict) - (vardecl andExternal (fun Bool (fun Bool Bool))) - (lam - a - Bool - (let - (nonrec) - (termbind (strict) (vardecl a Bool) a) - (lam - b - Bool - (let - (nonrec) - (termbind (strict) (vardecl b Bool) b) - { - [ - [ - { [ Bool_match a ] (all dead (type) Bool) } - (abs dead (type) b) - ] - (abs dead (type) False) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - [ [ andExternal True ] False ] - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + ~andExternal : Bool -> Bool -> Bool + = \(a : Bool) -> + let + !a : Bool = a + in + \(b : Bool) -> + let + !b : Bool = b + in + Bool_match + a + {all dead. Bool} + (/\dead -> b) + (/\dead -> False) + {all dead. dead} + in + andExternal True False) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/applicationFunction.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/applicationFunction.pir.golden index 1404fdb370a..f5a7ad7ede3 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/applicationFunction.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/applicationFunction.pir.golden @@ -1,70 +1,23 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl myDollar (all a (type) (all b (type) (fun (fun a b) (fun a b))))) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a b) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a b)) f) - (lam - a a (let (nonrec) (termbind (strict) (vardecl a a) a) [ f a ]) - ) - ) - ) - ) - ) - ) - [ - [ - { { myDollar (con integer) } (con integer) } - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ [ addInteger (con integer 1) ] x ] - ) - ) - ] - (con integer 1) - ] - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~myDollar : all a b. (a -> b) -> a -> b + = /\a b -> + \(f : a -> b) -> + let + !f : a -> b = f + in + \(a : a) -> let !a : a = a in f a + in + myDollar + {integer} + {integer} + (\(x : integer) -> let !x : integer = x in addInteger 1 x) + 1) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden index 07560d9cd8f..1ff79a6452d 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/mutualRecursionUnfoldings.pir.golden @@ -1,103 +1,37 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (strict) - (vardecl - subtractInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin subtractInteger) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl evenDirect (fun (con integer) Bool)) - (lam - n - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl n (con integer)) n) - (termbind - (strict) - (vardecl b (con bool)) - [ [ equalsInteger n ] (con integer 0) ] - ) - { - [ - [ - { - [ Bool_match [ [ [ { ifThenElse Bool } b ] True ] False ] ] - (all dead (type) Bool) - } - (abs dead (type) True) - ] - (abs - dead - (type) - [ oddDirect [ [ subtractInteger n ] (con integer 1) ] ] - ) - ] - (all dead (type) dead) - } - ) - ) - ) - (termbind - (nonstrict) - (vardecl oddDirect (fun (con integer) Bool)) - (lam - n - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl n (con integer)) n) - (termbind - (strict) - (vardecl b (con bool)) - [ [ equalsInteger n ] (con integer 0) ] - ) - { - [ - [ - { - [ Bool_match [ [ [ { ifThenElse Bool } b ] True ] False ] ] - (all dead (type) Bool) - } - (abs dead (type) False) - ] - (abs - dead - (type) - [ evenDirect [ [ subtractInteger n ] (con integer 1) ] ] - ) - ] - (all dead (type) dead) - } - ) - ) - ) - [ evenDirect (con integer 4) ] - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !subtractInteger : integer -> integer -> integer = subtractInteger + in + letrec + ~evenDirect : integer -> Bool + = \(n : integer) -> + let + !n : integer = n + !b : bool = equalsInteger n 0 + in + Bool_match + (ifThenElse {Bool} b True False) + {all dead. Bool} + (/\dead -> True) + (/\dead -> oddDirect (subtractInteger n 1)) + {all dead. dead} + ~oddDirect : integer -> Bool + = \(n : integer) -> + let + !n : integer = n + !b : bool = equalsInteger n 0 + in + Bool_match + (ifThenElse {Bool} b True False) + {all dead. Bool} + (/\dead -> False) + (/\dead -> evenDirect (subtractInteger n 1)) + {all dead. dead} + in + evenDirect 4) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/nandDirect.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/nandDirect.pir.golden index 142605f2382..8c9d99a15aa 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/nandDirect.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/nandDirect.pir.golden @@ -1,58 +1,29 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (nonstrict) - (vardecl nandDirect (fun Bool (fun Bool Bool))) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - { - [ - [ - { [ Bool_match ds ] (all dead (type) Bool) } - (abs dead (type) False) - ] - (abs - dead - (type) - { - [ - [ - { [ Bool_match ds ] (all dead (type) Bool) } - (abs dead (type) False) - ] - (abs dead (type) True) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - [ [ nandDirect True ] False ] - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + ~nandDirect : Bool -> Bool -> Bool + = \(ds : Bool) -> + let + !ds : Bool = ds + in + \(ds : Bool) -> + let + !ds : Bool = ds + in + Bool_match + ds + {all dead. Bool} + (/\dead -> False) + (/\dead -> + Bool_match + ds + {all dead. Bool} + (/\dead -> False) + (/\dead -> True) + {all dead. dead}) + {all dead. dead} + in + nandDirect True False) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/polyMap.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/polyMap.pir.golden index 5939fbfe33e..e91f5bf25b7 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/polyMap.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/polyMap.pir.golden @@ -1,159 +1,47 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl - build - (all - a - (type) - (fun (all b (type) (fun (fun a (fun b b)) (fun b b))) [ List a ]) - ) - ) - (abs - a - (type) - (lam - g - (all b (type) (fun (fun a (fun b b)) (fun b b))) - [ - [ - { g [ List a ] } - (lam ds a (lam ds [ List a ] [ [ { Cons a } ds ] ds ])) - ] - { Nil a } - ] - ) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl - mapDirect - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ List a ] [ List b ]))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a b) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a b)) f) - (lam - l - [ List a ] - (let - (nonrec) - (termbind (strict) (vardecl l [ List a ]) l) - { - [ - [ - { - [ { List_match a } l ] - (all dead (type) [ List b ]) - } - (abs dead (type) { Nil b }) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs - dead - (type) - [ - [ { Cons b } [ f x ] ] - [ [ { { mapDirect a } b } f ] xs ] - ] - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - ) - ) - [ - [ - { { mapDirect (con integer) } (con integer) } - [ addInteger (con integer 1) ] - ] - [ - { build (con integer) } - (abs - a - (type) - (lam - c - (fun (con integer) (fun a a)) - (lam - n a [ [ c (con integer 0) ] [ [ c (con integer 1) ] n ] ] - ) - ) - ) - ] - ] - ) - ) - ) - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + ~build : all a. (all b. (a -> b -> b) -> b -> b) -> List a + = /\a -> + \(g : all b. (a -> b -> b) -> b -> b) -> + g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) + in + letrec + ~mapDirect : all a b. (a -> b) -> List a -> List b + = /\a b -> + \(f : a -> b) -> + let + !f : a -> b = f + in + \(l : List a) -> + let + !l : List a = l + in + List_match + {a} + l + {all dead. List b} + (/\dead -> Nil {b}) + (\(x : a) (xs : List a) -> + /\dead -> Cons {b} (f x) (mapDirect {a} {b} f xs)) + {all dead. dead} + in + mapDirect + {integer} + {integer} + (addInteger 1) + (build {integer} (/\a -> \(c : integer -> a -> a) (n : a) -> c 0 (c 1 n)))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/recordSelector.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/recordSelector.pir.golden index 3f6b9ee1c06..428fc3542fc 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/recordSelector.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/recordSelector.pir.golden @@ -1,33 +1,10 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyMonoRecord (type)) - - MyMonoRecord_match - (vardecl - MyMonoRecord (fun (con integer) (fun (con integer) MyMonoRecord)) - ) - ) - ) - (termbind - (nonstrict) - (vardecl mrA (fun MyMonoRecord (con integer))) - (lam - ds - MyMonoRecord - [ - { [ MyMonoRecord_match ds ] (con integer) } - (lam ds (con integer) (lam ds (con integer) ds)) - ] - ) - ) - (lam - ds - MyMonoRecord - (let (nonrec) (termbind (strict) (vardecl ds MyMonoRecord) ds) [ mrA ds ]) - ) - ) -) \ No newline at end of file + data MyMonoRecord | MyMonoRecord_match where + MyMonoRecord : integer -> integer -> MyMonoRecord + ~mrA : MyMonoRecord -> integer + = \(ds : MyMonoRecord) -> + MyMonoRecord_match ds {integer} (\(ds : integer) (ds : integer) -> ds) + in + \(ds : MyMonoRecord) -> let !ds : MyMonoRecord = ds in mrA ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/recordSelectorExternal.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/recordSelectorExternal.pir.golden index 34a6948254d..bfd891dd56b 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/recordSelectorExternal.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/recordSelectorExternal.pir.golden @@ -1,35 +1,10 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl MyExternalRecord (type)) - - MyExternalRecord_match - (vardecl MyExternalRecord (fun (con integer) MyExternalRecord)) - ) - ) - (termbind - (nonstrict) - (vardecl myExternal (fun MyExternalRecord (con integer))) - (lam - ds - MyExternalRecord - [ - { [ MyExternalRecord_match ds ] (con integer) } - (lam ds (con integer) ds) - ] - ) - ) - (lam - ds - MyExternalRecord - (let - (nonrec) - (termbind (strict) (vardecl ds MyExternalRecord) ds) - [ myExternal ds ] - ) - ) - ) -) \ No newline at end of file + data MyExternalRecord | MyExternalRecord_match where + MyExternalRecord : integer -> MyExternalRecord + ~myExternal : MyExternalRecord -> integer + = \(ds : MyExternalRecord) -> + MyExternalRecord_match ds {integer} (\(ds : integer) -> ds) + in + \(ds : MyExternalRecord) -> let !ds : MyExternalRecord = ds in myExternal ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples2.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples2.pir.golden index 510b82bcbe1..5de4434470c 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples2.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples2.pir.golden @@ -1,67 +1,26 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl UTuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - UTuple2_match - (vardecl UTuple2 (fun a (fun b [ [ UTuple2 a ] b ]))) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - unboxedTuple - (fun [ [ UTuple2 (con integer) ] (con integer) ] (con integer)) - ) - (lam - ds - [ [ UTuple2 (con integer) ] (con integer) ] - [ - { - [ { { UTuple2_match (con integer) } (con integer) } ds ] - (con integer) - } - (lam i (con integer) (lam j (con integer) [ [ addInteger i ] j ])) - ] - ) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ unboxedTuple [ [ { { UTuple2 (con integer) } (con integer) } x ] x ] ] - ) - ) - ) -) \ No newline at end of file + data (UTuple2 :: * -> * -> *) a b | UTuple2_match where + UTuple2 : a -> b -> UTuple2 a b + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~unboxedTuple : UTuple2 integer integer -> integer + = \(ds : UTuple2 integer integer) -> + UTuple2_match + {integer} + {integer} + ds + {integer} + (\(i : integer) (j : integer) -> addInteger i j) + in + \(x : integer) -> + let + !x : integer = x + in + unboxedTuple (UTuple2 {integer} {integer} x x)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples2Tuples.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples2Tuples.pir.golden index 10461b44148..152474293af 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples2Tuples.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples2Tuples.pir.golden @@ -1,334 +1,58 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl UTuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - UTuple2_match - (vardecl UTuple2 (fun a (fun b [ [ UTuple2 a ] b ]))) - ) - ) - (datatypebind - (datatype - (tyvardecl - UTuple5 - (fun - (type) (fun (type) (fun (type) (fun (type) (fun (type) (type))))) - ) - ) - (tyvardecl a (type)) - (tyvardecl b (type)) - (tyvardecl c (type)) - (tyvardecl d (type)) - (tyvardecl e (type)) - UTuple5_match - (vardecl - UTuple5 - (fun - a - (fun - b (fun c (fun d (fun e [ [ [ [ [ UTuple5 a ] b ] c ] d ] e ]))) - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - unboxedTuple - (fun - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ) - ) - (lam - ds - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - [ - { - [ - { - { - { - { { UTuple5_match (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - ds - ] - (con integer) - } - (lam - i - (con integer) - (lam - j - (con integer) - (lam - k - (con integer) - (lam - l - (con integer) - (lam - m - (con integer) - [ - [ - addInteger - [ - [ - addInteger - [ [ addInteger [ [ addInteger i ] j ] ] k ] - ] - l - ] - ] - m - ] - ) - ) - ) - ) - ) - ] - ) - ) - (termbind - (nonstrict) - (vardecl - unboxedTuples2Tuple - (fun - [ - [ - UTuple2 - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - (con integer) - ) - ) - (lam - ds - [ - [ + data (UTuple2 :: * -> * -> *) a b | UTuple2_match where + UTuple2 : a -> b -> UTuple2 a b + data (UTuple5 :: * -> * -> * -> * -> * -> *) a b c d e | UTuple5_match where + UTuple5 : a -> b -> c -> d -> e -> UTuple5 a b c d e + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~unboxedTuple : UTuple5 integer integer integer integer integer -> integer + = \(ds : UTuple5 integer integer integer integer integer) -> + UTuple5_match + {integer} + {integer} + {integer} + {integer} + {integer} + ds + {integer} + (\(i : integer) + (j : integer) + (k : integer) + (l : integer) + (m : integer) -> + addInteger (addInteger (addInteger (addInteger i j) k) l) m) + ~unboxedTuples2Tuple : + UTuple2 + (UTuple5 integer integer integer integer integer) + (UTuple5 integer integer integer integer integer) -> + integer + = \(ds : UTuple2 - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - [ - { - [ - { - { - UTuple2_match - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ] - } - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] (con integer) - ] - (con integer) - ] - (con integer) - ] - } - ds - ] - (con integer) - } - (lam - i - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (lam - j - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - [ [ addInteger [ unboxedTuple i ] ] [ unboxedTuple j ] ] - ) - ) - ] - ) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ - unboxedTuples2Tuple - [ - [ - { - { - UTuple2 - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ] - } - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] (con integer) - ] - (con integer) - ] - (con integer) - ] - } - [ - [ - [ - [ - [ - { - { - { - { { UTuple5 (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - x - ] - x - ] - x - ] - x - ] - x - ] - ] - [ - [ - [ - [ - [ - { - { - { - { { UTuple5 (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - x - ] - x - ] - x - ] - x - ] - x - ] - ] - ] - ) - ) - ) -) \ No newline at end of file + (UTuple5 integer integer integer integer integer) + (UTuple5 integer integer integer integer integer)) -> + UTuple2_match + {UTuple5 integer integer integer integer integer} + {UTuple5 integer integer integer integer integer} + ds + {integer} + (\(i : UTuple5 integer integer integer integer integer) + (j : UTuple5 integer integer integer integer integer) -> + addInteger (unboxedTuple i) (unboxedTuple j)) + in + \(x : integer) -> + let + !x : integer = x + in + unboxedTuples2Tuple + (UTuple2 + {UTuple5 integer integer integer integer integer} + {UTuple5 integer integer integer integer integer} + (UTuple5 {integer} {integer} {integer} {integer} {integer} x x x x x) + (UTuple5 {integer} {integer} {integer} {integer} {integer} x x x x x))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples3.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples3.pir.golden index 078fa9dfd42..7343906f4bd 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples3.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples3.pir.golden @@ -1,94 +1,28 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl UTuple3 (fun (type) (fun (type) (fun (type) (type))))) - (tyvardecl a (type)) (tyvardecl b (type)) (tyvardecl c (type)) - UTuple3_match - (vardecl UTuple3 (fun a (fun b (fun c [ [ [ UTuple3 a ] b ] c ])))) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - unboxedTuple - (fun - [ [ [ UTuple3 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ) - ) - (lam - ds - [ [ [ UTuple3 (con integer) ] (con integer) ] (con integer) ] - [ - { - [ - { - { { UTuple3_match (con integer) } (con integer) } (con integer) - } - ds - ] - (con integer) - } - (lam - i - (con integer) - (lam - j - (con integer) - (lam k (con integer) [ [ addInteger [ [ addInteger i ] j ] ] k ]) - ) - ) - ] - ) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ - unboxedTuple - [ - [ - [ - { { { UTuple3 (con integer) } (con integer) } (con integer) } x - ] - x - ] - x - ] - ] - ) - ) - ) -) \ No newline at end of file + data (UTuple3 :: * -> * -> * -> *) a b c | UTuple3_match where + UTuple3 : a -> b -> c -> UTuple3 a b c + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~unboxedTuple : UTuple3 integer integer integer -> integer + = \(ds : UTuple3 integer integer integer) -> + UTuple3_match + {integer} + {integer} + {integer} + ds + {integer} + (\(i : integer) (j : integer) (k : integer) -> + addInteger (addInteger i j) k) + in + \(x : integer) -> + let + !x : integer = x + in + unboxedTuple (UTuple3 {integer} {integer} {integer} x x x)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples3Tuples.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples3Tuples.pir.golden index 2ff64478ea1..ec5c8922248 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples3Tuples.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples3Tuples.pir.golden @@ -1,424 +1,66 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl UTuple3 (fun (type) (fun (type) (fun (type) (type))))) - (tyvardecl a (type)) (tyvardecl b (type)) (tyvardecl c (type)) - UTuple3_match - (vardecl UTuple3 (fun a (fun b (fun c [ [ [ UTuple3 a ] b ] c ])))) - ) - ) - (datatypebind - (datatype - (tyvardecl - UTuple5 - (fun - (type) (fun (type) (fun (type) (fun (type) (fun (type) (type))))) - ) - ) - (tyvardecl a (type)) - (tyvardecl b (type)) - (tyvardecl c (type)) - (tyvardecl d (type)) - (tyvardecl e (type)) - UTuple5_match - (vardecl - UTuple5 - (fun - a - (fun - b (fun c (fun d (fun e [ [ [ [ [ UTuple5 a ] b ] c ] d ] e ]))) - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - unboxedTuple - (fun - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ) - ) - (lam - ds - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - [ - { - [ - { - { - { - { { UTuple5_match (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - ds - ] - (con integer) - } - (lam - i - (con integer) - (lam - j - (con integer) - (lam - k - (con integer) - (lam - l - (con integer) - (lam - m - (con integer) - [ - [ - addInteger - [ - [ - addInteger - [ [ addInteger [ [ addInteger i ] j ] ] k ] - ] - l - ] - ] - m - ] - ) - ) - ) - ) - ) - ] - ) - ) - (termbind - (nonstrict) - (vardecl - unboxedTuples3Tuple - (fun - [ - [ - [ - UTuple3 - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] (con integer) - ] - (con integer) - ] - (con integer) - ] - ] - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - (con integer) - ) - ) - (lam - ds - [ - [ - [ - UTuple3 - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - ] - [ - { - [ - { - { - { - UTuple3_match - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ] - } - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ] - } - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] (con integer) - ] - (con integer) - ] - (con integer) - ] - } - ds - ] - (con integer) - } - (lam - i - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (lam - j - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (lam - k - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] (con integer) - ] - (con integer) - ] - (con integer) - ] - [ - [ - addInteger - [ [ addInteger [ unboxedTuple i ] ] [ unboxedTuple j ] ] - ] - [ unboxedTuple k ] - ] - ) - ) - ) - ] - ) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ - unboxedTuples3Tuple - [ - [ - [ - { - { - { - UTuple3 - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ] - } - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ] - } - [ - [ - [ - [ [ UTuple5 (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ] - } - [ - [ - [ - [ - [ - { - { - { - { { UTuple5 (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - x - ] - x - ] - x - ] - x - ] - x - ] - ] - [ - [ - [ - [ - [ - { - { - { - { { UTuple5 (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - x - ] - x - ] - x - ] - x - ] - x - ] - ] - [ - [ - [ - [ - [ - { - { - { - { { UTuple5 (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - x - ] - x - ] - x - ] - x - ] - x - ] - ] - ] - ) - ) - ) -) \ No newline at end of file + data (UTuple3 :: * -> * -> * -> *) a b c | UTuple3_match where + UTuple3 : a -> b -> c -> UTuple3 a b c + data (UTuple5 :: * -> * -> * -> * -> * -> *) a b c d e | UTuple5_match where + UTuple5 : a -> b -> c -> d -> e -> UTuple5 a b c d e + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~unboxedTuple : UTuple5 integer integer integer integer integer -> integer + = \(ds : UTuple5 integer integer integer integer integer) -> + UTuple5_match + {integer} + {integer} + {integer} + {integer} + {integer} + ds + {integer} + (\(i : integer) + (j : integer) + (k : integer) + (l : integer) + (m : integer) -> + addInteger (addInteger (addInteger (addInteger i j) k) l) m) + ~unboxedTuples3Tuple : + UTuple3 + (UTuple5 integer integer integer integer integer) + (UTuple5 integer integer integer integer integer) + (UTuple5 integer integer integer integer integer) -> + integer + = \(ds : + UTuple3 + (UTuple5 integer integer integer integer integer) + (UTuple5 integer integer integer integer integer) + (UTuple5 integer integer integer integer integer)) -> + UTuple3_match + {UTuple5 integer integer integer integer integer} + {UTuple5 integer integer integer integer integer} + {UTuple5 integer integer integer integer integer} + ds + {integer} + (\(i : UTuple5 integer integer integer integer integer) + (j : UTuple5 integer integer integer integer integer) + (k : UTuple5 integer integer integer integer integer) -> + addInteger + (addInteger (unboxedTuple i) (unboxedTuple j)) + (unboxedTuple k)) + in + \(x : integer) -> + let + !x : integer = x + in + unboxedTuples3Tuple + (UTuple3 + {UTuple5 integer integer integer integer integer} + {UTuple5 integer integer integer integer integer} + {UTuple5 integer integer integer integer integer} + (UTuple5 {integer} {integer} {integer} {integer} {integer} x x x x x) + (UTuple5 {integer} {integer} {integer} {integer} {integer} x x x x x) + (UTuple5 {integer} {integer} {integer} {integer} {integer} x x x x x))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples4.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples4.pir.golden index d10fbd1a9fe..2570ca5f6d9 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples4.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples4.pir.golden @@ -1,131 +1,29 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl - UTuple4 (fun (type) (fun (type) (fun (type) (fun (type) (type))))) - ) - (tyvardecl a (type)) - (tyvardecl b (type)) - (tyvardecl c (type)) - (tyvardecl d (type)) - UTuple4_match - (vardecl - UTuple4 - (fun a (fun b (fun c (fun d [ [ [ [ UTuple4 a ] b ] c ] d ])))) - ) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - unboxedTuple - (fun - [ - [ [ [ UTuple4 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ) - ) - (lam - ds - [ - [ [ [ UTuple4 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - [ - { - [ - { - { - { { UTuple4_match (con integer) } (con integer) } - (con integer) - } - (con integer) - } - ds - ] - (con integer) - } - (lam - i - (con integer) - (lam - j - (con integer) - (lam - k - (con integer) - (lam - l - (con integer) - [ - [ addInteger [ [ addInteger [ [ addInteger i ] j ] ] k ] ] l - ] - ) - ) - ) - ) - ] - ) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ - unboxedTuple - [ - [ - [ - [ - { - { - { { UTuple4 (con integer) } (con integer) } (con integer) - } - (con integer) - } - x - ] - x - ] - x - ] - x - ] - ] - ) - ) - ) -) \ No newline at end of file + data (UTuple4 :: * -> * -> * -> * -> *) a b c d | UTuple4_match where + UTuple4 : a -> b -> c -> d -> UTuple4 a b c d + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~unboxedTuple : UTuple4 integer integer integer integer -> integer + = \(ds : UTuple4 integer integer integer integer) -> + UTuple4_match + {integer} + {integer} + {integer} + {integer} + ds + {integer} + (\(i : integer) (j : integer) (k : integer) (l : integer) -> + addInteger (addInteger (addInteger i j) k) l) + in + \(x : integer) -> + let + !x : integer = x + in + unboxedTuple (UTuple4 {integer} {integer} {integer} {integer} x x x x)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples5.pir.golden b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples5.pir.golden index ea628517666..5a3ebe78fd3 100644 --- a/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples5.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Functions/9.6/unfoldings/unboxedTuples5.pir.golden @@ -1,170 +1,35 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl - UTuple5 - (fun - (type) (fun (type) (fun (type) (fun (type) (fun (type) (type))))) - ) - ) - (tyvardecl a (type)) - (tyvardecl b (type)) - (tyvardecl c (type)) - (tyvardecl d (type)) - (tyvardecl e (type)) - UTuple5_match - (vardecl - UTuple5 - (fun - a - (fun - b (fun c (fun d (fun e [ [ [ [ [ UTuple5 a ] b ] c ] d ] e ]))) - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - unboxedTuple - (fun - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - (con integer) - ) - ) - (lam - ds - [ - [ - [ [ [ UTuple5 (con integer) ] (con integer) ] (con integer) ] - (con integer) - ] - (con integer) - ] - [ - { - [ - { - { - { - { { UTuple5_match (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - ds - ] - (con integer) - } - (lam - i - (con integer) - (lam - j - (con integer) - (lam - k - (con integer) - (lam - l - (con integer) - (lam - m - (con integer) - [ - [ - addInteger - [ - [ - addInteger - [ [ addInteger [ [ addInteger i ] j ] ] k ] - ] - l - ] - ] - m - ] - ) - ) - ) - ) - ) - ] - ) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ - unboxedTuple - [ - [ - [ - [ - [ - { - { - { - { { UTuple5 (con integer) } (con integer) } - (con integer) - } - (con integer) - } - (con integer) - } - x - ] - x - ] - x - ] - x - ] - x - ] - ] - ) - ) - ) -) \ No newline at end of file + data (UTuple5 :: * -> * -> * -> * -> * -> *) a b c d e | UTuple5_match where + UTuple5 : a -> b -> c -> d -> e -> UTuple5 a b c d e + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~unboxedTuple : UTuple5 integer integer integer integer integer -> integer + = \(ds : UTuple5 integer integer integer integer integer) -> + UTuple5_match + {integer} + {integer} + {integer} + {integer} + {integer} + ds + {integer} + (\(i : integer) + (j : integer) + (k : integer) + (l : integer) + (m : integer) -> + addInteger (addInteger (addInteger (addInteger i j) k) l) m) + in + \(x : integer) -> + let + !x : integer = x + in + unboxedTuple + (UTuple5 {integer} {integer} {integer} {integer} {integer} x x x x x)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Laziness/9.6/joinError.pir.golden b/plutus-tx-plugin/test/Plugin/Laziness/9.6/joinError.pir.golden index 43b6475d966..7f3635ae812 100644 --- a/plutus-tx-plugin/test/Plugin/Laziness/9.6/joinError.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Laziness/9.6/joinError.pir.golden @@ -1,67 +1,33 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype (tyvardecl Unit (type)) Unit_match (vardecl Unit Unit)) - ) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl error (all a (type) (fun (con unit) a))) - (abs a (type) (lam thunk (con unit) (error a))) - ) - (termbind (strict) (vardecl unitval (con unit)) (con unit ())) - (termbind - (nonstrict) - (vardecl joinError (fun Bool (fun Bool Unit))) - (lam - x - Bool - (let - (nonrec) - (termbind (strict) (vardecl x Bool) x) - (lam - y - Bool - (let - (nonrec) - (termbind (strict) (vardecl y Bool) y) - { - [ - [ - { [ Bool_match x ] (all dead (type) Unit) } - (abs - dead - (type) - { - [ - [ - { [ Bool_match y ] (all dead (type) Unit) } - (abs dead (type) [ { error Unit } unitval ]) - ] - (abs dead (type) Unit) - ] - (all dead (type) dead) - } - ) - ] - (abs dead (type) Unit) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - joinError - ) -) \ No newline at end of file + data Unit | Unit_match where + Unit : Unit + data Bool | Bool_match where + True : Bool + False : Bool + !error : all a. unit -> a = /\a -> \(thunk : unit) -> error {a} + !unitval : unit = () + ~joinError : Bool -> Bool -> Unit + = \(x : Bool) -> + let + !x : Bool = x + in + \(y : Bool) -> + let + !y : Bool = y + in + Bool_match + x + {all dead. Unit} + (/\dead -> + Bool_match + y + {all dead. Unit} + (/\dead -> error {Unit} unitval) + (/\dead -> Unit) + {all dead. dead}) + (/\dead -> Unit) + {all dead. dead} + in + joinError) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Laziness/9.6/joinErrorEval.eval.golden b/plutus-tx-plugin/test/Plugin/Laziness/9.6/joinErrorEval.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/Plugin/Laziness/9.6/joinErrorEval.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Laziness/9.6/joinErrorEval.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Laziness/9.6/lazyDepUnit.pir.golden b/plutus-tx-plugin/test/Plugin/Laziness/9.6/lazyDepUnit.pir.golden index 618f81d2b40..94eb661b012 100644 --- a/plutus-tx-plugin/test/Plugin/Laziness/9.6/lazyDepUnit.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Laziness/9.6/lazyDepUnit.pir.golden @@ -1,23 +1,9 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) (vardecl emptyByteString (con bytestring)) (con bytestring #) - ) - (termbind - (nonstrict) (vardecl emptyByteString (con bytestring)) emptyByteString - ) - (termbind - (nonstrict) - (vardecl monoId (fun (con bytestring) (con bytestring))) - (lam x (con bytestring) x) - ) - (termbind - (nonstrict) - (vardecl aByteString (con bytestring)) - [ monoId emptyByteString ] - ) - aByteString - ) -) \ No newline at end of file + !emptyByteString : bytestring = # + ~emptyByteString : bytestring = emptyByteString + ~monoId : bytestring -> bytestring = \(x : bytestring) -> x + ~aByteString : bytestring = monoId emptyByteString + in + aByteString) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Optimization/9.6/alwaysFails.uplc.golden b/plutus-tx-plugin/test/Plugin/Optimization/9.6/alwaysFails.uplc.golden index 4898f1b9518..84474f1e55a 100644 --- a/plutus-tx-plugin/test/Plugin/Optimization/9.6/alwaysFails.uplc.golden +++ b/plutus-tx-plugin/test/Plugin/Optimization/9.6/alwaysFails.uplc.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds_i0 (lam ds_i0 (lam ds_i0 (error))))) \ No newline at end of file +program 1.1.0 (\ds ds ds -> error) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Optimization/9.6/alwaysSucceeds.uplc.golden b/plutus-tx-plugin/test/Plugin/Optimization/9.6/alwaysSucceeds.uplc.golden index 458414d23a2..cc0fa6b6b80 100644 --- a/plutus-tx-plugin/test/Plugin/Optimization/9.6/alwaysSucceeds.uplc.golden +++ b/plutus-tx-plugin/test/Plugin/Optimization/9.6/alwaysSucceeds.uplc.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds_i0 (lam ds_i0 (lam ds_i0 (constr 0))))) \ No newline at end of file +program 1.1.0 (\ds ds ds -> constr 0 []) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/and.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/and.pir.golden index e9c4ed13828..01260387ea4 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/and.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/and.pir.golden @@ -1,40 +1,21 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - (lam - ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - { - [ - [ - { [ Bool_match ds ] (all dead (type) Bool) } - (abs dead (type) ds) - ] - (abs dead (type) False) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + in + \(ds : Bool) -> + let + !ds : Bool = ds + in + \(ds : Bool) -> + let + !ds : Bool = ds + in + Bool_match + ds + {all dead. Bool} + (/\dead -> ds) + (/\dead -> False) + {all dead. dead}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/andApply.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/andApply.eval.golden index f217693e82c..3a05a39aa43 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/andApply.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/andApply.eval.golden @@ -1 +1 @@ -(constr 1) \ No newline at end of file +constr 1 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/bool.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/bool.pir.golden index 55f951efd29..6817f273093 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/bool.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/bool.pir.golden @@ -1,15 +1,8 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - True - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + in + True) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/bytestring.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/bytestring.pir.golden index 6db4ca37033..93bd77be176 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/bytestring.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/bytestring.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con bytestring) ds)) \ No newline at end of file +program 1.1.0 (\(ds : bytestring) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/bytestringApply.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/bytestringApply.eval.golden index 654694afba7..e99e2cf725c 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/bytestringApply.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/bytestringApply.eval.golden @@ -1 +1 @@ -(con bytestring #68656c6c6f) \ No newline at end of file +#68656c6c6f \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/consByteString.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/consByteString.eval.golden index 654694afba7..e99e2cf725c 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/consByteString.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/consByteString.eval.golden @@ -1 +1 @@ -(con bytestring #68656c6c6f) \ No newline at end of file +#68656c6c6f \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/constructData1.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/constructData1.eval.golden index e3fa6e48c68..9c15a755675 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/constructData1.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/constructData1.eval.golden @@ -1 +1 @@ -(con data (I 1)) \ No newline at end of file +I 1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/decodeUtf8.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/decodeUtf8.eval.golden index b5b46ba8829..84ed78b69ba 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/decodeUtf8.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/decodeUtf8.eval.golden @@ -1 +1 @@ -(con string "hello") \ No newline at end of file +"hello" \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData1.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData1.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData1.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData1.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData2.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData2.eval.golden index 67af525910d..b665d049fe5 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData2.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData2.eval.golden @@ -1,5 +1 @@ -(constr - 0 - (con integer 1) - (constr 1 (con integer 2) (constr 1 (con integer 3) (constr 0))) -) \ No newline at end of file +constr 0 [1, (constr 1 [2, (constr 1 [3, (constr 0 [])])])] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData3.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData3.eval.golden index a94f80f17e3..bc5f2c982f4 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData3.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructData3.eval.golden @@ -1 +1 @@ -(constr 1 (con data (I 2)) (constr 1 (con data (I 3)) (constr 0))) \ No newline at end of file +constr 1 [(I 2), (constr 1 [(I 3), (constr 0 [])])] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructorData1.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructorData1.pir.golden index d35fbfd32ef..71d4b597974 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructorData1.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructorData1.pir.golden @@ -1,33 +1,8 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl unsafeDataAsI (fun (con data) (con integer))) - (builtin unIData) - ) - (termbind - (nonstrict) - (vardecl unsafeDataAsI (fun (con data) (con integer))) - (lam - d - (con data) - (let - (nonrec) - (termbind (strict) (vardecl d (con data)) d) - [ unsafeDataAsI d ] - ) - ) - ) - (lam - ds - (con data) - (let - (nonrec) - (termbind (strict) (vardecl ds (con data)) ds) - [ unsafeDataAsI ds ] - ) - ) - ) -) \ No newline at end of file + !unsafeDataAsI : data -> integer = unIData + ~unsafeDataAsI : data -> integer + = \(d : data) -> let !d : data = d in unsafeDataAsI d + in + \(ds : data) -> let !ds : data = ds in unsafeDataAsI ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructorData2.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructorData2.pir.golden index 2919c2b1560..59e0c7c3397 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructorData2.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/deconstructorData2.pir.golden @@ -1,488 +1,127 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fFunctorTuple2_$cfmap` - (all - c - (type) - (all - a - (type) - (all - b - (type) - (fun (fun a b) (fun [ [ Tuple2 c ] a ] [ [ Tuple2 c ] b ])) - ) - ) - ) - ) - (abs - c - (type) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a b) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a b)) f) - (lam - ds - [ [ Tuple2 c ] a ] - [ - { [ { { Tuple2_match c } a } ds ] [ [ Tuple2 c ] b ] } - (lam c c (lam a a [ [ { { Tuple2 c } b } c ] [ f a ] ])) - ] - ) - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fFunctorTuple2` - (all - c - (type) - [ - (lam - f - (fun (type) (type)) - (all - a (type) (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - [ Tuple2 c ] - ] - ) - ) - `$fFunctorTuple2_$cfmap` - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl - `$fFunctorList_$cfmap` - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ List a ] [ List b ]))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a b) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a b)) f) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] [ List b ])) - (lam - ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] - (all dead (type) [ List b ]) - } - (abs dead (type) { Nil b }) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs - dead - (type) - [ [ { Cons b } [ f x ] ] [ go xs ] ] - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fFunctorList` - [ - (lam - f - (fun (type) (type)) - (all - a (type) (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - List - ] - ) - `$fFunctorList_$cfmap` - ) - (termbind - (nonstrict) - (vardecl - `.` - (all - b - (type) - (all - c - (type) - (all a (type) (fun (fun b c) (fun (fun a b) (fun a c)))) - ) - ) - ) - (abs - b - (type) - (abs - c - (type) - (abs - a - (type) - (lam f (fun b c) (lam g (fun a b) (lam x a [ f [ g x ] ]))) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - fmap - (all - f - (fun (type) (type)) - (fun - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (all - a (type) (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - ) - ) - (abs - f - (fun (type) (type)) - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - v - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fHasFromOpaqueBuiltinDataBuiltinData_$cfromOpaque` - (fun (con data) (con data)) - ) - (lam eta (con data) eta) - ) - (termbind - (strict) - (vardecl - chooseList - (all - a (type) (all b (type) (fun [ (con list) a ] (fun b (fun b b)))) - ) - ) - (builtin chooseList) - ) - (termbind - (strict) - (vardecl head (all a (type) (fun [ (con list) a ] a))) - (builtin headList) - ) - (termbind - (strict) - (vardecl tail (all a (type) (fun [ (con list) a ] [ (con list) a ]))) - (builtin tailList) - ) - (termbind (strict) (vardecl unitval (con unit)) (con unit ())) - (termbind - (nonstrict) - (vardecl - `$fHasFromOpaqueBuiltinListList_$cfromOpaque` - (all - arep - (type) - (all - a - (type) - (fun - [ [ (lam arep (type) (lam a (type) (fun arep a))) arep ] a ] - (fun [ (con list) arep ] [ List a ]) - ) - ) - ) - ) - (abs - arep - (type) - (abs - a - (type) - (lam - `$dHasFromOpaque` - [ [ (lam arep (type) (lam a (type) (fun arep a))) arep ] a ] - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ (con list) arep ] [ List a ])) - (lam + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + ~`$fFunctorTuple2_$cfmap` : all c a b. (a -> b) -> Tuple2 c a -> Tuple2 c b + = /\c a b -> + \(f : a -> b) -> + let + !f : a -> b = f + in + \(ds : Tuple2 c a) -> + Tuple2_match + {c} + {a} + ds + {Tuple2 c b} + (\(c : c) (a : a) -> Tuple2 {c} {b} c (f a)) + ~`$fFunctorTuple2` : + all c. (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) (Tuple2 c) + = `$fFunctorTuple2_$cfmap` + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + ~`$fFunctorList_$cfmap` : all a b. (a -> b) -> List a -> List b + = /\a b -> + \(f : a -> b) -> + let + !f : a -> b = f + in + letrec + ~go : List a -> List b + = \(ds : List a) -> + List_match + {a} + ds + {all dead. List b} + (/\dead -> Nil {b}) + (\(x : a) (xs : List a) -> + /\dead -> Cons {b} (f x) (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + ~`$fFunctorList` : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) List + = `$fFunctorList_$cfmap` + ~`.` : all b c a. (b -> c) -> (a -> b) -> a -> c + = /\b c a -> \(f : b -> c) (g : a -> b) (x : a) -> f (g x) + ~fmap : + all (f :: * -> *). + (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f -> + (all a b. (a -> b) -> f a -> f b) + = /\(f :: * -> *) -> + \(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f) -> v + ~`$fHasFromOpaqueBuiltinDataBuiltinData_$cfromOpaque` : data -> data + = \(eta : data) -> eta + !chooseList : all a b. list a -> b -> b -> b = chooseList + !head : all a. list a -> a = headList + !tail : all a. list a -> list a = tailList + !unitval : unit = () + ~`$fHasFromOpaqueBuiltinListList_$cfromOpaque` : + all arep a. (\arep a -> arep -> a) arep a -> list arep -> List a + = /\arep a -> + \(`$dHasFromOpaque` : (\arep a -> arep -> a) arep a) -> + letrec + ~go : list arep -> List a + = \(l : list arep) -> + let + !l : list arep = l + in + chooseList + {arep} + {unit -> List a} l - [ (con list) arep ] - (let - (nonrec) - (termbind (strict) (vardecl l [ (con list) arep ]) l) - [ - [ - [ - [ - { - { chooseList arep } - (fun (con unit) [ List a ]) - } - l - ] - (lam ds (con unit) { Nil a }) - ] - (lam - ds - (con unit) - [ - [ - { Cons a } - [ `$dHasFromOpaque` [ { head arep } l ] ] - ] - [ go [ { tail arep } l ] ] - ] - ) - ] - unitval - ] - ) - ) - ) - (lam eta [ (con list) arep ] [ go eta ]) - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl - fst (all a (type) (all b (type) (fun [ [ (con pair) a ] b ] a))) - ) - (builtin fstPair) - ) - (termbind - (strict) - (vardecl - snd (all a (type) (all b (type) (fun [ [ (con pair) a ] b ] b))) - ) - (builtin sndPair) - ) - (termbind - (strict) - (vardecl - unsafeDataAsConstr - (fun - (con data) - [ [ (con pair) (con integer) ] [ (con list) (con data) ] ] - ) - ) - (builtin unConstrData) - ) - (termbind - (nonstrict) - (vardecl - unsafeDataAsConstr - (fun (con data) [ [ Tuple2 (con integer) ] [ List (con data) ] ]) - ) - (lam - d - (con data) - (let - (nonrec) - (termbind (strict) (vardecl d (con data)) d) - (termbind - (strict) - (vardecl - p [ [ (con pair) (con integer) ] [ (con list) (con data) ] ] - ) - [ unsafeDataAsConstr d ] - ) - [ - [ - { { Tuple2 (con integer) } [ List (con data) ] } - [ { { fst (con integer) } [ (con list) (con data) ] } p ] - ] - (let - (nonrec) - (termbind - (strict) - (vardecl a [ (con list) (con data) ]) - [ { { snd (con integer) } [ (con list) (con data) ] } p ] - ) - [ - [ - { - { - `$fHasFromOpaqueBuiltinListList_$cfromOpaque` - (con data) - } - (con data) - } - `$fHasFromOpaqueBuiltinDataBuiltinData_$cfromOpaque` - ] - a - ] - ) - ] - ) - ) - ) - (termbind - (strict) - (vardecl unsafeDataAsI (fun (con data) (con integer))) - (builtin unIData) - ) - (termbind - (nonstrict) - (vardecl unsafeDataAsI (fun (con data) (con integer))) - (lam - d - (con data) + (\(ds : unit) -> Nil {a}) + (\(ds : unit) -> + Cons + {a} + (`$dHasFromOpaque` (head {arep} l)) + (go (tail {arep} l))) + unitval + in + \(eta : list arep) -> go eta + !fst : all a b. pair a b -> a = fstPair + !snd : all a b. pair a b -> b = sndPair + !unsafeDataAsConstr : data -> pair integer (list data) = unConstrData + ~unsafeDataAsConstr : data -> Tuple2 integer (List data) + = \(d : data) -> + let + !d : data = d + !p : pair integer (list data) = unsafeDataAsConstr d + in + Tuple2 + {integer} + {List data} + (fst {integer} {list data} p) (let - (nonrec) - (termbind (strict) (vardecl d (con data)) d) - [ unsafeDataAsI d ] - ) - ) - ) - (lam - ds - (con data) - (let - (nonrec) - (termbind (strict) (vardecl ds (con data)) ds) - [ - [ - [ - [ - { - { - { `.` (fun [ List (con data) ] [ List (con integer) ]) } - (fun - [ [ Tuple2 (con integer) ] [ List (con data) ] ] - [ [ Tuple2 (con integer) ] [ List (con integer) ] ] - ) - } - (fun (con data) (con integer)) - } - { - { - [ - { fmap [ Tuple2 (con integer) ] } - { `$fFunctorTuple2` (con integer) } - ] - [ List (con data) ] - } - [ List (con integer) ] - } - ] - { - { [ { fmap List } `$fFunctorList` ] (con data) } - (con integer) - } - ] - unsafeDataAsI - ] - [ unsafeDataAsConstr ds ] - ] - ) - ) - ) - ) - ) -) \ No newline at end of file + !a : list data = snd {integer} {list data} p + in + `$fHasFromOpaqueBuiltinListList_$cfromOpaque` + {data} + {data} + `$fHasFromOpaqueBuiltinDataBuiltinData_$cfromOpaque` + a) + !unsafeDataAsI : data -> integer = unIData + ~unsafeDataAsI : data -> integer + = \(d : data) -> let !d : data = d in unsafeDataAsI d + in + \(ds : data) -> + let + !ds : data = ds + in + `.` + {List data -> List integer} + {Tuple2 integer (List data) -> Tuple2 integer (List integer)} + {data -> integer} + (fmap + {Tuple2 integer} + (`$fFunctorTuple2` {integer}) + {List data} + {List integer}) + (fmap {List} `$fFunctorList` {data} {integer}) + unsafeDataAsI + (unsafeDataAsConstr ds)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/emptyByteString.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/emptyByteString.pir.golden index 6db4ca37033..93bd77be176 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/emptyByteString.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/emptyByteString.pir.golden @@ -1 +1 @@ -(program 1.1.0 (lam ds (con bytestring) ds)) \ No newline at end of file +program 1.1.0 (\(ds : bytestring) -> ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/emptyByteStringApply.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/emptyByteStringApply.eval.golden index 7b1b940e59b..4287ca86179 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/emptyByteStringApply.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/emptyByteStringApply.eval.golden @@ -1 +1 @@ -(con bytestring #) \ No newline at end of file +# \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/encodeUtf8.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/encodeUtf8.pir.golden index f0dee62dd45..1baeeabe040 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/encodeUtf8.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/encodeUtf8.pir.golden @@ -1,17 +1,7 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl encodeUtf (fun (con string) (con bytestring))) - (builtin encodeUtf8) - ) - (termbind - (nonstrict) - (vardecl encodeUtf (fun (con string) (con bytestring))) - encodeUtf - ) - [ encodeUtf (con string "abc") ] - ) -) \ No newline at end of file + !encodeUtf : string -> bytestring = encodeUtf8 + ~encodeUtf : string -> bytestring = encodeUtf + in + encodeUtf "abc") \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/equalsByteString.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/equalsByteString.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/equalsByteString.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/equalsByteString.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/equalsString.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/equalsString.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/equalsString.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/equalsString.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/error.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/error.pir.golden index 5b6f2bb1928..d46d4314de9 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/error.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/error.pir.golden @@ -1,19 +1,9 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl error (all a (type) (fun (con unit) a))) - (abs a (type) (lam thunk (con unit) (error a))) - ) - (termbind (strict) (vardecl unitval (con unit)) (con unit ())) - (typebind (tyvardecl Unit (type)) (all a (type) (fun a a))) - (termbind - (nonstrict) - (vardecl error (all a (type) (fun Unit a))) - (abs a (type) (lam x Unit [ { error a } unitval ])) - ) - { error (con integer) } - ) -) \ No newline at end of file + !error : all a. unit -> a = /\a -> \(thunk : unit) -> error {a} + !unitval : unit = () + Unit = all a. a -> a + ~error : all a. Unit -> a = /\a -> \(x : Unit) -> error {a} unitval + in + error {integer}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden index 908f2d1125c..fd644ee88bd 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElse.pir.golden @@ -1,77 +1,34 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - { - [ - [ - { - [ Bool_match [ [ equalsInteger ds ] ds ] ] - (all dead (type) (con integer)) - } - (abs dead (type) ds) - ] - (abs dead (type) ds) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> + let + !ds : integer = ds + in + Bool_match + (equalsInteger ds ds) + {all dead. integer} + (/\dead -> ds) + (/\dead -> ds) + {all dead. dead}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElseApply.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElseApply.eval.golden index d135c1204f4..d8263ee9860 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElseApply.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ifThenElseApply.eval.golden @@ -1 +1 @@ -(con integer 2) \ No newline at end of file +2 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/indexByteString.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/indexByteString.eval.golden index f427e8438c5..dec4c59e4a0 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/indexByteString.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/indexByteString.eval.golden @@ -1 +1 @@ -(con integer 104) \ No newline at end of file +104 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/int.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/int.pir.golden index c897a619d7e..0d9b8af24ca 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/int.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/int.pir.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 1)) \ No newline at end of file +program 1.1.0 1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/int2.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/int2.pir.golden index 2b513f80b57..71e8cc5eae5 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/int2.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/int2.pir.golden @@ -1 +1 @@ -(program 1.1.0 (con integer 2)) \ No newline at end of file +program 1.1.0 2 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden index 55dd06e248e..0e6729c2c85 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intCompare.pir.golden @@ -1,67 +1,25 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (strict) - (vardecl - lessThanInteger (fun (con integer) (fun (con integer) (con bool))) - ) - (builtin lessThanInteger) - ) - (termbind - (nonstrict) - (vardecl lessThanInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ lessThanInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ [ lessThanInteger ds ] ds ] - ) - ) - ) - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !lessThanInteger : integer -> integer -> bool = lessThanInteger + ~lessThanInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = lessThanInteger x y + in + ifThenElse {Bool} b True False + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> let !ds : integer = ds in lessThanInteger ds ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intDiv.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intDiv.pir.golden index 98a7e3c4af7..fd061087ebf 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intDiv.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intDiv.pir.golden @@ -1,53 +1,16 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl - divideInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin divideInteger) - ) - (termbind - (nonstrict) - (vardecl - divideInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ divideInteger x ] y ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ [ divideInteger ds ] ds ] - ) - ) - ) - ) - ) -) \ No newline at end of file + !divideInteger : integer -> integer -> integer = divideInteger + ~divideInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in divideInteger x y + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> let !ds : integer = ds in divideInteger ds ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden index bc35ea6a6bd..210db8b4ce5 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEq.pir.golden @@ -1,65 +1,25 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ [ equalsInteger ds ] ds ] - ) - ) - ) - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> let !ds : integer = ds in equalsInteger ds ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEqApply.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEqApply.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEqApply.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intEqApply.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intPlus.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intPlus.pir.golden index 9242b7bbe02..f07957a3925 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intPlus.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intPlus.pir.golden @@ -1,49 +1,16 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ [ addInteger ds ] ds ] - ) - ) - ) - ) - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> let !ds : integer = ds in addInteger ds ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intPlusApply.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intPlusApply.eval.golden index 7ce41fb5eca..e440e5c8425 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/intPlusApply.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/intPlusApply.eval.golden @@ -1 +1 @@ -(con integer 3) \ No newline at end of file +3 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/lengthOfByteString.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/lengthOfByteString.eval.golden index 4c1ba608f00..7813681f5b4 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/lengthOfByteString.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/lengthOfByteString.eval.golden @@ -1 +1 @@ -(con integer 5) \ No newline at end of file +5 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ltByteString.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ltByteString.eval.golden index 1dd2b8ed5d3..aac851c2ef6 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/ltByteString.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/ltByteString.eval.golden @@ -1 +1 @@ -(constr 0) \ No newline at end of file +constr 0 [] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/matchData1.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/matchData1.eval.golden index 005b0a452f3..fa9c0c5cdf4 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/matchData1.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/matchData1.eval.golden @@ -1 +1 @@ -(constr 0 (con integer 1)) \ No newline at end of file +constr 0 [1] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/serialiseData.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/serialiseData.pir.golden index d7c2e5e9f52..ec8dd895f3b 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/serialiseData.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/serialiseData.pir.golden @@ -1,17 +1,7 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl serialiseData (fun (con data) (con bytestring))) - (builtin serialiseData) - ) - (termbind - (nonstrict) - (vardecl serialiseData (fun (con data) (con bytestring))) - serialiseData - ) - serialiseData - ) -) \ No newline at end of file + !serialiseData : data -> bytestring = serialiseData + ~serialiseData : data -> bytestring = serialiseData + in + serialiseData) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/serialiseDataApply.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/serialiseDataApply.eval.golden index 9d0671c076f..99ea178bd48 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/serialiseDataApply.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/serialiseDataApply.eval.golden @@ -1 +1 @@ -(con bytestring #01) \ No newline at end of file +#01 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/sha2_256.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/sha2_256.eval.golden index da957a9a88d..c3b0e7455b9 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/sha2_256.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/sha2_256.eval.golden @@ -1,3 +1 @@ -(con - bytestring #2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824 -) \ No newline at end of file +#2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/string.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/string.pir.golden index d5b9b57e7ce..eeb1da5e892 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/string.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/string.pir.golden @@ -1 +1 @@ -(program 1.1.0 (con string "text")) \ No newline at end of file +program 1.1.0 "text" \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/stringLiteral.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/stringLiteral.pir.golden index 43f834bd3ec..bf29f9f2f71 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/stringLiteral.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/stringLiteral.pir.golden @@ -1 +1 @@ -(program 1.1.0 (con string "abc")) \ No newline at end of file +program 1.1.0 "abc" \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/trace.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/trace.pir.golden index 362c2266480..fc3a8aed30f 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/trace.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/trace.pir.golden @@ -1,28 +1,9 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype (tyvardecl Unit (type)) Unit_match (vardecl Unit Unit)) - ) - (termbind - (strict) - (vardecl trace (all a (type) (fun (con string) (fun a a)))) - (builtin trace) - ) - (termbind - (nonstrict) - (vardecl trace (all a (type) (fun (con string) (fun a a)))) - trace - ) - (lam - ds - (con string) - (let - (nonrec) - (termbind (strict) (vardecl ds (con string)) ds) - [ [ { trace Unit } ds ] Unit ] - ) - ) - ) -) \ No newline at end of file + data Unit | Unit_match where + Unit : Unit + !trace : all a. string -> a -> a = trace + ~trace : all a. string -> a -> a = trace + in + \(ds : string) -> let !ds : string = ds in trace {Unit} ds Unit) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/traceComplex.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/traceComplex.pir.golden index e3b395a9920..b8a086b0efb 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/traceComplex.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/traceComplex.pir.golden @@ -1,69 +1,31 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl trace (all a (type) (fun (con string) (fun a a)))) - (builtin trace) - ) - (termbind - (nonstrict) - (vardecl trace (all a (type) (fun (con string) (fun a a)))) - trace - ) - (datatypebind - (datatype (tyvardecl Unit (type)) Unit_match (vardecl Unit Unit)) - ) - (termbind - (strict) - (vardecl error (all a (type) (fun (con unit) a))) - (abs a (type) (lam thunk (con unit) (error a))) - ) - (termbind (strict) (vardecl unitval (con unit)) (con unit ())) - (termbind - (nonstrict) - (vardecl traceError (all a (type) (fun (con string) a))) - (abs - a - (type) - (lam - str - (con string) - (let - (nonrec) - (termbind (strict) (vardecl str (con string)) str) - (termbind (strict) (vardecl x Unit) [ [ { trace Unit } str ] Unit ]) - [ { error a } unitval ] - ) - ) - ) - ) - (lam + data Bool | Bool_match where + True : Bool + False : Bool + !trace : all a. string -> a -> a = trace + ~trace : all a. string -> a -> a = trace + data Unit | Unit_match where + Unit : Unit + !error : all a. unit -> a = /\a -> \(thunk : unit) -> error {a} + !unitval : unit = () + ~traceError : all a. string -> a + = /\a -> + \(str : string) -> + let + !str : string = str + !x : Unit = trace {Unit} str Unit + in + error {a} unitval + in + \(ds : Bool) -> + let + !ds : Bool = ds + in + Bool_match ds - Bool - (let - (nonrec) - (termbind (strict) (vardecl ds Bool) ds) - { - [ - [ - { [ Bool_match ds ] (all dead (type) Unit) } - (abs dead (type) [ [ { trace Unit } (con string "yes") ] Unit ]) - ] - (abs dead (type) [ { traceError Unit } (con string "no") ]) - ] - (all dead (type) dead) - } - ) - ) - ) -) \ No newline at end of file + {all dead. Unit} + (/\dead -> trace {Unit} "yes" Unit) + (/\dead -> traceError {Unit} "no") + {all dead. dead}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/tuple.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/tuple.pir.golden index de2352d47eb..5ef927c3dfd 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/tuple.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/tuple.pir.golden @@ -1,18 +1,7 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - [ - [ { { Tuple2 (con integer) } (con integer) } (con integer 1) ] - (con integer 2) - ] - ) -) \ No newline at end of file + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + in + Tuple2 {integer} {integer} 1 2) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/tupleConstDest.eval.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/tupleConstDest.eval.golden index 132831f390c..56a6051ca2b 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/tupleConstDest.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/tupleConstDest.eval.golden @@ -1 +1 @@ -(con integer 1) \ No newline at end of file +1 \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/tupleMatch.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/tupleMatch.pir.golden index 71e89808b6b..56298407fe9 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/tupleMatch.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/tupleMatch.pir.golden @@ -1,24 +1,13 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - (lam + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + in + \(ds : Tuple2 integer integer) -> + Tuple2_match + {integer} + {integer} ds - [ [ Tuple2 (con integer) ] (con integer) ] - [ - { - [ { { Tuple2_match (con integer) } (con integer) } ds ] (con integer) - } - (lam ipv (con integer) (lam ipv (con integer) ipv)) - ] - ) - ) -) \ No newline at end of file + {integer} + (\(ipv : integer) (ipv : integer) -> ipv)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden index 5f8be59e296..9c78f87257a 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/verify.pir.golden @@ -1,96 +1,38 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (strict) - (vardecl - verifyEd25519Signature - (fun - (con bytestring) - (fun (con bytestring) (fun (con bytestring) (con bool))) - ) - ) - (builtin verifyEd25519Signature) - ) - (termbind - (nonstrict) - (vardecl - verifyEd25519Signature - (fun - (con bytestring) (fun (con bytestring) (fun (con bytestring) Bool)) - ) - ) - (lam - pubKey - (con bytestring) - (let - (nonrec) - (termbind (strict) (vardecl pubKey (con bytestring)) pubKey) - (lam - message - (con bytestring) - (let - (nonrec) - (termbind (strict) (vardecl message (con bytestring)) message) - (lam - signature - (con bytestring) - (let - (nonrec) - (termbind - (strict) (vardecl signature (con bytestring)) signature - ) - (termbind - (strict) - (vardecl b (con bool)) - [ [ [ verifyEd25519Signature pubKey ] message ] signature ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - ) - ) - (lam - ds - (con bytestring) - (let - (nonrec) - (termbind (strict) (vardecl ds (con bytestring)) ds) - (lam - ds - (con bytestring) - (let - (nonrec) - (termbind (strict) (vardecl ds (con bytestring)) ds) - (lam - ds - (con bytestring) - (let - (nonrec) - (termbind (strict) (vardecl ds (con bytestring)) ds) - [ [ [ verifyEd25519Signature ds ] ds ] ds ] - ) - ) - ) - ) - ) - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !verifyEd25519Signature : bytestring -> bytestring -> bytestring -> bool + = verifyEd25519Signature + ~verifyEd25519Signature : bytestring -> bytestring -> bytestring -> Bool + = \(pubKey : bytestring) -> + let + !pubKey : bytestring = pubKey + in + \(message : bytestring) -> + let + !message : bytestring = message + in + \(signature : bytestring) -> + let + !signature : bytestring = signature + !b : bool = verifyEd25519Signature pubKey message signature + in + ifThenElse {Bool} b True False + in + \(ds : bytestring) -> + let + !ds : bytestring = ds + in + \(ds : bytestring) -> + let + !ds : bytestring = ds + in + \(ds : bytestring) -> + let + !ds : bytestring = ds + in + verifyEd25519Signature ds ds ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden b/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden index 5ab46d5c199..ff9202015b3 100644 --- a/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Primitives/9.6/void.pir.golden @@ -1,92 +1,43 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (nonstrict) (vardecl fail (fun (con unit) Bool)) (lam ds (con unit) False) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (termbind (strict) (vardecl x' Bool) [ [ equalsInteger ds ] ds ]) - (termbind (strict) (vardecl y' Bool) [ [ equalsInteger ds ] ds ]) - { - [ - [ - { [ Bool_match x' ] (all dead (type) Bool) } - (abs - dead - (type) - { - [ - [ - { [ Bool_match y' ] (all dead (type) Bool) } - (abs dead (type) True) - ] - (abs dead (type) [ fail (con unit ()) ]) - ] - (all dead (type) dead) - } - ) - ] - (abs dead (type) [ fail (con unit ()) ]) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + ~fail : unit -> Bool = \(ds : unit) -> False + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> + let + !ds : integer = ds + !x' : Bool = equalsInteger ds ds + !y' : Bool = equalsInteger ds ds + in + Bool_match + x' + {all dead. Bool} + (/\dead -> + Bool_match + y' + {all dead. Bool} + (/\dead -> True) + (/\dead -> fail ()) + {all dead. dead}) + (/\dead -> fail ()) + {all dead. dead}) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden index 1add0957b66..b714fb429ee 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt.pir.golden @@ -1,87 +1,32 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ - [ - [ - { (builtin trace) (fun (con unit) (con integer)) } - (con string "entering addInteger") - ] - (lam - thunk - (con unit) - [ - [ - { (builtin trace) (con integer) } - (con string "exiting addInteger") - ] - [ [ addInteger x ] y ] - ] - ) - ] - (con unit ()) - ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl addInt (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - [ - [ - [ - { - (builtin trace) - (fun (con unit) (fun (con integer) (con integer))) - } - (con string "entering addInt") - ] - (lam - thunk - (con unit) - [ - [ - { (builtin trace) (fun (con integer) (con integer)) } - (con string "exiting addInt") - ] - [ addInteger x ] - ] - ) - ] - (con unit ()) - ] - ) - ) - ) - addInt - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + in + trace + {unit -> integer} + "entering addInteger-129" + (\(thunk : unit) -> + trace {integer} "exiting addInteger-129" (addInteger x y)) + () + ~addInt : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + trace + {unit -> integer -> integer} + "entering addInt-126" + (\(thunk : unit) -> + trace {integer -> integer} "exiting addInt-126" (addInteger x)) + () + in + addInt) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden index 68eeb5e4784..9bd01c9535d 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/addInt3.eval.golden @@ -1 +1 @@ -[entering addInt, exiting addInt] \ No newline at end of file +[entering addInt-126, exiting addInt-126] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden index a316f49d6bc..14e3e61691c 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch1.eval.golden @@ -1,6 +1,6 @@ -[ entering runIdentity -, exiting runIdentity -, entering newtypeFunction -, exiting newtypeFunction -, entering `$fFoldableIdentity` -, exiting `$fFoldableIdentity` ] \ No newline at end of file +[ entering runIdentity-129 +, exiting runIdentity-129 +, entering newtypeFunction-137 +, exiting newtypeFunction-137 +, entering `$fFoldableIdentity`-131 +, exiting `$fFoldableIdentity`-131 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden index 38bf38703e4..b0bc86d7306 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/argMismatch2.eval.golden @@ -1 +1 @@ -[entering obscuredFunction, exiting obscuredFunction] \ No newline at end of file +[entering obscuredFunction-127, exiting obscuredFunction-127] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden index 4752d376629..0d688af7c21 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fact4.eval.golden @@ -1,36 +1,36 @@ -[ entering fact -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering fact -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering fact -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering fact -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering fact -, entering equalsInteger -, exiting equalsInteger -, exiting fact -, entering multiplyInteger -, exiting multiplyInteger -, exiting fact -, entering multiplyInteger -, exiting multiplyInteger -, exiting fact -, entering multiplyInteger -, exiting multiplyInteger -, exiting fact -, entering multiplyInteger -, exiting multiplyInteger -, exiting fact ] \ No newline at end of file +[ entering fact-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering subtractInteger-150 +, exiting subtractInteger-150 +, entering fact-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering subtractInteger-150 +, exiting subtractInteger-150 +, entering fact-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering subtractInteger-150 +, exiting subtractInteger-150 +, entering fact-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering subtractInteger-150 +, exiting subtractInteger-150 +, entering fact-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, exiting fact-126 +, entering multiplyInteger-144 +, exiting multiplyInteger-144 +, exiting fact-126 +, entering multiplyInteger-144 +, exiting multiplyInteger-144 +, exiting fact-126 +, entering multiplyInteger-144 +, exiting multiplyInteger-144 +, exiting fact-126 +, entering multiplyInteger-144 +, exiting multiplyInteger-144 +, exiting fact-126 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden index 739a651ce85..6df2672558c 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib.pir.golden @@ -1,251 +1,96 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ - [ - [ - { (builtin trace) (fun (con unit) (con integer)) } - (con string "entering addInteger") - ] - (lam - thunk - (con unit) - [ - [ - { (builtin trace) (con integer) } - (con string "exiting addInteger") - ] - [ [ addInteger x ] y ] - ] - ) - ] - (con unit ()) - ] - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ - [ - [ - { (builtin trace) (fun (con unit) Bool) } - (con string "entering equalsInteger") - ] - (lam - thunk - (con unit) - [ - [ - { (builtin trace) Bool } - (con string "exiting equalsInteger") - ] - (let - (nonrec) - (termbind - (strict) - (vardecl b (con bool)) - [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ] - ) - ] - (con unit ()) - ] - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl - subtractInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (builtin subtractInteger) - ) - (termbind - (nonstrict) - (vardecl - subtractInteger (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ - [ - [ - { (builtin trace) (fun (con unit) (con integer)) } - (con string "entering subtractInteger") - ] - (lam - thunk - (con unit) - [ - [ - { (builtin trace) (con integer) } - (con string "exiting subtractInteger") - ] - [ [ subtractInteger x ] y ] - ] - ) - ] - (con unit ()) - ] - ) - ) - ) - ) - ) - (let - (rec) - (termbind - (nonstrict) - (vardecl fib (fun (con integer) (con integer))) - (lam - n - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl n (con integer)) n) - [ - [ - [ - { (builtin trace) (fun (con unit) (con integer)) } - (con string "entering fib") - ] - (lam - thunk - (con unit) - [ - [ - { (builtin trace) (con integer) } - (con string "exiting fib") - ] - { - [ - [ - { - [ - Bool_match [ [ equalsInteger n ] (con integer 0) ] - ] - (all dead (type) (con integer)) - } - (abs dead (type) (con integer 0)) - ] - (abs - dead - (type) - { - [ - [ - { - [ - Bool_match - [ [ equalsInteger n ] (con integer 1) ] - ] - (all dead (type) (con integer)) - } - (abs dead (type) (con integer 1)) - ] - (abs - dead - (type) - [ - [ - addInteger - [ - fib - [ [ subtractInteger n ] (con integer 1) ] - ] - ] - [ - fib - [ [ subtractInteger n ] (con integer 2) ] - ] - ] - ) - ] - (all dead (type) dead) - } - ) - ] - (all dead (type) dead) - } - ] - ) - ] - (con unit ()) - ] - ) - ) - ) - fib - ) - ) -) \ No newline at end of file + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + in + trace + {unit -> integer} + "entering addInteger-148" + (\(thunk : unit) -> + trace {integer} "exiting addInteger-148" (addInteger x y)) + () + data Bool | Bool_match where + True : Bool + False : Bool + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + in + trace + {unit -> Bool} + "entering equalsInteger-133" + (\(thunk : unit) -> + trace + {Bool} + "exiting equalsInteger-133" + (let + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False)) + () + !subtractInteger : integer -> integer -> integer = subtractInteger + ~subtractInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + in + trace + {unit -> integer} + "entering subtractInteger-154" + (\(thunk : unit) -> + trace + {integer} + "exiting subtractInteger-154" + (subtractInteger x y)) + () + in + letrec + ~fib : integer -> integer + = \(n : integer) -> + let + !n : integer = n + in + trace + {unit -> integer} + "entering fib-126" + (\(thunk : unit) -> + trace + {integer} + "exiting fib-126" + (Bool_match + (equalsInteger n 0) + {all dead. integer} + (/\dead -> 0) + (/\dead -> + Bool_match + (equalsInteger n 1) + {all dead. integer} + (/\dead -> 1) + (/\dead -> + addInteger + (fib (subtractInteger n 1)) + (fib (subtractInteger n 2))) + {all dead. dead}) + {all dead. dead})) + () + in + fib) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden index 9ba81e62d9d..dd4c4ebeacf 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/fib4.eval.golden @@ -1,74 +1,74 @@ -[ entering fib -, entering equalsInteger -, exiting equalsInteger -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering fib -, entering equalsInteger -, exiting equalsInteger -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering fib -, entering equalsInteger -, exiting equalsInteger -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering fib -, entering equalsInteger -, exiting equalsInteger -, entering equalsInteger -, exiting equalsInteger -, exiting fib -, entering subtractInteger -, exiting subtractInteger -, entering fib -, entering equalsInteger -, exiting equalsInteger -, exiting fib -, entering addInteger -, exiting addInteger -, exiting fib -, entering subtractInteger -, exiting subtractInteger -, entering fib -, entering equalsInteger -, exiting equalsInteger -, entering equalsInteger -, exiting equalsInteger -, exiting fib -, entering addInteger -, exiting addInteger -, exiting fib -, entering subtractInteger -, exiting subtractInteger -, entering fib -, entering equalsInteger -, exiting equalsInteger -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering fib -, entering equalsInteger -, exiting equalsInteger -, entering equalsInteger -, exiting equalsInteger -, exiting fib -, entering subtractInteger -, exiting subtractInteger -, entering fib -, entering equalsInteger -, exiting equalsInteger -, exiting fib -, entering addInteger -, exiting addInteger -, exiting fib -, entering addInteger -, exiting addInteger -, exiting fib ] \ No newline at end of file +[ entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, exiting fib-126 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, exiting fib-126 +, entering addInteger-148 +, exiting addInteger-148 +, exiting fib-126 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, exiting fib-126 +, entering addInteger-148 +, exiting addInteger-148 +, exiting fib-126 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, exiting fib-126 +, entering subtractInteger-154 +, exiting subtractInteger-154 +, entering fib-126 +, entering equalsInteger-133 +, exiting equalsInteger-133 +, exiting fib-126 +, entering addInteger-148 +, exiting addInteger-148 +, exiting fib-126 +, entering addInteger-148 +, exiting addInteger-148 +, exiting fib-126 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/id.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/id.eval.golden index ca3df46b62a..b44a413ba8b 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/id.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/id.eval.golden @@ -1 +1 @@ -[entering id, exiting id, entering id, exiting id] \ No newline at end of file +[entering id-127, exiting id-127, entering id-127, exiting id-127] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/idCode.pir.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/idCode.pir.golden index 50417060cea..7bb5394e1a3 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/idCode.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/idCode.pir.golden @@ -1,33 +1,13 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (nonstrict) - (vardecl id (all a (type) (fun a a))) - (abs - a - (type) - (lam - x - a - [ - [ - [ - { (builtin trace) (fun (con unit) a) } - (con string "entering id") - ] - (lam - thunk - (con unit) - [ [ { (builtin trace) a } (con string "exiting id") ] x ] - ) - ] - (con unit ()) - ] - ) - ) - ) - [ { id (con integer) } [ { id (con integer) } (con integer 1) ] ] - ) -) \ No newline at end of file + ~id : all a. a -> a + = /\a -> + \(x : a) -> + trace + {unit -> a} + "entering id-127" + (\(thunk : unit) -> trace {a} "exiting id-127" x) + () + in + id {integer} (id {integer} 1)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFun.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFun.eval.golden index 7da8f83021d..55db6efde8c 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFun.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFun.eval.golden @@ -1,10 +1,10 @@ -[ entering f -, entering addInteger -, exiting addInteger -, exiting f -, entering f -, entering addInteger -, exiting addInteger -, exiting f -, entering addInteger -, exiting addInteger ] \ No newline at end of file +[ entering f-138 +, entering addInteger-132 +, exiting addInteger-132 +, exiting f-138 +, entering f-138 +, entering addInteger-132 +, exiting addInteger-132 +, exiting f-138 +, entering addInteger-132 +, exiting addInteger-132 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFunMoreArg.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFunMoreArg.eval.golden index dc9cc516585..dcf5f62de33 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFunMoreArg.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letInFunMoreArg.eval.golden @@ -1,12 +1,12 @@ -[ entering f -, entering addInteger -, exiting addInteger -, exiting f -, entering f -, entering addInteger -, exiting addInteger -, exiting f -, entering addInteger -, exiting addInteger -, entering multiplyInteger -, exiting multiplyInteger ] \ No newline at end of file +[ entering f-140 +, entering addInteger-134 +, exiting addInteger-134 +, exiting f-140 +, entering f-140 +, entering addInteger-134 +, exiting addInteger-134 +, exiting f-140 +, entering addInteger-134 +, exiting addInteger-134 +, entering multiplyInteger-142 +, exiting multiplyInteger-142 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letRecInFun.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letRecInFun.eval.golden index 6ffdaa268eb..29dd653b9b7 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/letRecInFun.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/letRecInFun.eval.golden @@ -1,28 +1,28 @@ -[ entering f -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering f -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering f -, entering equalsInteger -, exiting equalsInteger -, entering subtractInteger -, exiting subtractInteger -, entering f -, entering equalsInteger -, exiting equalsInteger -, exiting f -, entering addInteger -, exiting addInteger -, exiting f -, entering addInteger -, exiting addInteger -, exiting f -, entering addInteger -, exiting addInteger -, exiting f ] \ No newline at end of file +[ entering f-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-152 +, exiting subtractInteger-152 +, entering f-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-152 +, exiting subtractInteger-152 +, entering f-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, entering subtractInteger-152 +, exiting subtractInteger-152 +, entering f-128 +, entering equalsInteger-135 +, exiting equalsInteger-135 +, exiting f-128 +, entering addInteger-146 +, exiting addInteger-146 +, exiting f-128 +, entering addInteger-146 +, exiting addInteger-146 +, exiting f-128 +, entering addInteger-146 +, exiting addInteger-146 +, exiting f-128 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/swap.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/swap.eval.golden index 238bb53a13e..95ccf2e19ca 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/swap.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/swap.eval.golden @@ -1 +1 @@ -[entering swap, exiting swap] \ No newline at end of file +[entering swap-133, exiting swap-133] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Profiling/9.6/typeclass.eval.golden b/plutus-tx-plugin/test/Plugin/Profiling/9.6/typeclass.eval.golden index 1d9414013aa..fe995dbadbe 100644 --- a/plutus-tx-plugin/test/Plugin/Profiling/9.6/typeclass.eval.golden +++ b/plutus-tx-plugin/test/Plugin/Profiling/9.6/typeclass.eval.golden @@ -1,12 +1,12 @@ -[ entering useTypeclass -, entering methodA -, exiting methodA -, entering addInteger -, exiting addInteger -, entering methodB -, exiting methodB -, entering subtractInteger -, exiting subtractInteger -, entering addInteger -, exiting addInteger -, exiting useTypeclass ] \ No newline at end of file +[ entering useTypeclass-135 +, entering methodA-149 +, exiting methodA-149 +, entering addInteger-142 +, exiting addInteger-142 +, entering methodB-160 +, exiting methodB-160 +, entering subtractInteger-172 +, exiting subtractInteger-172 +, entering addInteger-142 +, exiting addInteger-142 +, exiting useTypeclass-135 ] \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden index 54360ee1160..7644ed22f9f 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/compareTest.pir.golden @@ -1,477 +1,181 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl - lessThanEqualsInteger (fun (con integer) (fun (con integer) (con bool))) - ) - (builtin lessThanEqualsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (datatypebind - (datatype - (tyvardecl Ordering (type)) - - Ordering_match - (vardecl EQ Ordering) (vardecl GT Ordering) (vardecl LT Ordering) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fOrdInteger_$ccompare` - (fun (con integer) (fun (con integer) Ordering)) - ) - (lam - eta - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) eta) - (lam - eta - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) eta) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - { - [ - [ - { - [ - Bool_match [ [ [ { ifThenElse Bool } b ] True ] False ] - ] - (all dead (type) Ordering) - } - (abs dead (type) EQ) - ] - (abs - dead - (type) - (let - (nonrec) - (termbind - (strict) - (vardecl b (con bool)) - [ [ lessThanEqualsInteger x ] y ] - ) - { - [ - [ - { - [ - Bool_match - [ [ [ { ifThenElse Bool } b ] True ] False ] - ] - (all dead (type) Ordering) - } - (abs dead (type) LT) - ] - (abs dead (type) GT) - ] - (all dead (type) dead) - } - ) - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fOrdInteger_$cmax` - (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) - (vardecl b (con bool)) - [ [ lessThanEqualsInteger x ] y ] - ) - { - [ - [ - { - [ - Bool_match [ [ [ { ifThenElse Bool } b ] True ] False ] - ] - (all dead (type) (con integer)) - } - (abs dead (type) y) - ] - (abs dead (type) x) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fOrdInteger_$cmin` - (fun (con integer) (fun (con integer) (con integer))) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) - (vardecl b (con bool)) - [ [ lessThanEqualsInteger x ] y ] - ) - { - [ - [ - { - [ - Bool_match [ [ [ { ifThenElse Bool } b ] True ] False ] - ] - (all dead (type) (con integer)) - } - (abs dead (type) x) - ] - (abs dead (type) y) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (termbind - (strict) - (vardecl - lessThanInteger (fun (con integer) (fun (con integer) (con bool))) - ) - (builtin lessThanInteger) - ) - (termbind - (nonstrict) - (vardecl - greaterThanEqualsInteger (fun (con integer) (fun (con integer) Bool)) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ - [ [ { ifThenElse Bool } [ [ lessThanInteger x ] y ] ] False ] - True - ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl greaterThanInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ - [ - [ { ifThenElse Bool } [ [ lessThanEqualsInteger x ] y ] ] - False - ] - True - ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - lessThanEqualsInteger (fun (con integer) (fun (con integer) Bool)) - ) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) - (vardecl b (con bool)) - [ [ lessThanEqualsInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl lessThanInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ lessThanInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Ord (fun (type) (type))) - (tyvardecl a (type)) - Ord_match - (vardecl - CConsOrd - (fun - [ (lam a (type) (fun a (fun a Bool))) a ] - (fun - (fun a (fun a Ordering)) - (fun - (fun a (fun a Bool)) - (fun - (fun a (fun a Bool)) - (fun - (fun a (fun a Bool)) - (fun - (fun a (fun a Bool)) - (fun (fun a (fun a a)) (fun (fun a (fun a a)) [ Ord a ])) - ) - ) - ) - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl `$fOrdInteger` [ Ord (con integer) ]) - [ - [ - [ - [ - [ - [ - [ - [ { CConsOrd (con integer) } equalsInteger ] - `$fOrdInteger_$ccompare` - ] - lessThanInteger - ] - lessThanEqualsInteger - ] - greaterThanInteger - ] - greaterThanEqualsInteger - ] + !equalsInteger : integer -> integer -> bool = equalsInteger + !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + data Bool | Bool_match where + True : Bool + False : Bool + data Ordering | Ordering_match where + EQ : Ordering + GT : Ordering + LT : Ordering + ~`$fOrdInteger_$ccompare` : integer -> integer -> Ordering + = \(eta : integer) -> + let + !x : integer = eta + in + \(eta : integer) -> + let + !y : integer = eta + !b : bool = equalsInteger x y + in + Bool_match + (ifThenElse {Bool} b True False) + {all dead. Ordering} + (/\dead -> EQ) + (/\dead -> + let + !b : bool = lessThanEqualsInteger x y + in + Bool_match + (ifThenElse {Bool} b True False) + {all dead. Ordering} + (/\dead -> LT) + (/\dead -> GT) + {all dead. dead}) + {all dead. dead} + ~`$fOrdInteger_$cmax` : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = lessThanEqualsInteger x y + in + Bool_match + (ifThenElse {Bool} b True False) + {all dead. integer} + (/\dead -> y) + (/\dead -> x) + {all dead. dead} + ~`$fOrdInteger_$cmin` : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = lessThanEqualsInteger x y + in + Bool_match + (ifThenElse {Bool} b True False) + {all dead. integer} + (/\dead -> x) + (/\dead -> y) + {all dead. dead} + ~equalsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = equalsInteger x y + in + ifThenElse {Bool} b True False + !lessThanInteger : integer -> integer -> bool = lessThanInteger + ~greaterThanEqualsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + in + ifThenElse {Bool} (lessThanInteger x y) False True + ~greaterThanInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + in + ifThenElse {Bool} (lessThanEqualsInteger x y) False True + ~lessThanEqualsInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = lessThanEqualsInteger x y + in + ifThenElse {Bool} b True False + ~lessThanInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = lessThanInteger x y + in + ifThenElse {Bool} b True False + data (Ord :: * -> *) a | Ord_match where + CConsOrd : + (\a -> a -> a -> Bool) a -> + (a -> a -> Ordering) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> Bool) -> + (a -> a -> a) -> + (a -> a -> a) -> + Ord a + ~`$fOrdInteger` : Ord integer + = CConsOrd + {integer} + equalsInteger + `$fOrdInteger_$ccompare` + lessThanInteger + lessThanEqualsInteger + greaterThanInteger + greaterThanEqualsInteger `$fOrdInteger_$cmax` - ] - `$fOrdInteger_$cmin` - ] - ) - (termbind - (nonstrict) - (vardecl compare (all a (type) (fun [ Ord a ] (fun a (fun a Ordering))))) - (abs - a - (type) - (lam - v - [ Ord a ] - [ - { [ { Ord_match a } v ] (fun a (fun a Ordering)) } - (lam + `$fOrdInteger_$cmin` + ~compare : all a. Ord a -> a -> a -> Ordering + = /\a -> + \(v : Ord a) -> + Ord_match + {a} v - [ (lam a (type) (fun a (fun a Bool))) a ] - (lam - v - (fun a (fun a Ordering)) - (lam - v - (fun a (fun a Bool)) - (lam - v - (fun a (fun a Bool)) - (lam - v - (fun a (fun a Bool)) - (lam - v - (fun a (fun a Bool)) - (lam v (fun a (fun a a)) (lam v (fun a (fun a a)) v)) - ) - ) - ) - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - opCompare (all a (type) (fun [ Ord a ] (fun a (fun a Ordering)))) - ) - (abs - a - (type) - (lam - `$dOrd` - [ Ord a ] - (lam - a - a - (let - (nonrec) - (termbind (strict) (vardecl a a) a) - (lam - b - a - (let - (nonrec) - (termbind (strict) (vardecl b a) b) - { - [ - [ - [ - { - [ - Ordering_match - [ [ [ { compare a } `$dOrd` ] a ] b ] - ] - (all dead (type) Ordering) - } - (abs dead (type) EQ) - ] - (abs dead (type) LT) - ] - (abs dead (type) GT) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - ) - ) - [ - [ [ { opCompare (con integer) } `$fOrdInteger` ] (con integer 1) ] - (con integer 2) - ] - ) -) \ No newline at end of file + {a -> a -> Ordering} + (\(v : (\a -> a -> a -> Bool) a) + (v : a -> a -> Ordering) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> Bool) + (v : a -> a -> a) + (v : a -> a -> a) -> + v) + ~opCompare : all a. Ord a -> a -> a -> Ordering + = /\a -> + \(`$dOrd` : Ord a) (a : a) -> + let + !a : a = a + in + \(b : a) -> + let + !b : a = b + in + Ordering_match + (compare {a} `$dOrd` a b) + {all dead. Ordering} + (/\dead -> EQ) + (/\dead -> LT) + (/\dead -> GT) + {all dead. dead} + in + opCompare {integer} `$fOrdInteger` 1 2) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/concatTest.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/concatTest.pir.golden index 3e53744bb45..e607ce51f5b 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/concatTest.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/concatTest.pir.golden @@ -1,349 +1,104 @@ -(program +program 1.1.0 - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl - `$fFoldableList_$cfoldr` - (all - a - (type) - (all b (type) (fun (fun a (fun b b)) (fun b (fun [ List a ] b)))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a (fun b b)) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a (fun b b))) f) - (lam - z - b - (let - (nonrec) - (termbind (strict) (vardecl z b) z) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] b)) - (lam - ds - [ List a ] - { - [ - [ - { [ { List_match a } ds ] (all dead (type) b) } - (abs dead (type) z) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs dead (type) [ [ f x ] [ go xs ] ]) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fFoldableList` - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a (fun b b)) (fun b (fun [ t a ] b)))) - ) - ) - List - ] - ) - `$fFoldableList_$cfoldr` - ) - (termbind - (nonstrict) - (vardecl - build - (all - a - (type) - (fun (all b (type) (fun (fun a (fun b b)) (fun b b))) [ List a ]) - ) - ) - (abs - a - (type) - (lam - g - (all b (type) (fun (fun a (fun b b)) (fun b b))) - [ - [ - { g [ List a ] } - (lam ds a (lam ds [ List a ] [ [ { Cons a } ds ] ds ])) - ] - { Nil a } - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - concat - (all - t - (fun (type) (type)) - (all - a - (type) - (fun - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all - b (type) (fun (fun a (fun b b)) (fun b (fun [ t a ] b))) - ) - ) - ) - t - ] - (fun [ t [ List a ] ] [ List a ]) - ) - ) - ) - ) - (abs - t - (fun (type) (type)) - (abs - a - (type) - (lam - `$dFoldable` - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all - b (type) (fun (fun a (fun b b)) (fun b (fun [ t a ] b))) - ) - ) - ) - t - ] - (lam - xs - [ t [ List a ] ] - (let - (nonrec) - (termbind (strict) (vardecl xs [ t [ List a ] ]) xs) - [ - { build a } - (abs - b - (type) - (lam - c - (fun a (fun b b)) - (let - (nonrec) - (termbind (strict) (vardecl c (fun a (fun b b))) c) - (lam - n - b - (let - (nonrec) - (termbind (strict) (vardecl n b) n) - [ - [ - [ - { { `$dFoldable` [ List a ] } b } - (lam - x - [ List a ] - (let - (nonrec) - (termbind - (strict) (vardecl x [ List a ]) x - ) - (lam - y - b - (let - (nonrec) - (termbind (strict) (vardecl y b) y) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] b)) - (lam - ds - [ List a ] - { - [ - [ - { - [ - { List_match a } ds - ] - (all dead (type) b) - } - (abs dead (type) y) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs - dead - (type) - [ - [ c x ] [ go xs ] - ] - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - [ go x ] - ) - ) - ) - ) - ) - ] - n - ] - xs - ] - ) - ) - ) - ) - ) - ] - ) - ) - ) - ) - ) - ) - [ - [ { { concat List } (con integer) } `$fFoldableList` ] - [ - { build [ List (con integer) ] } - (abs - a - (type) - (lam - c - (fun [ List (con integer) ] (fun a a)) - (lam - n - a - [ - [ - c - [ - { build (con integer) } - (abs - a - (type) - (lam - c - (fun (con integer) (fun a a)) - (lam - n - a - [ - [ c (con integer 1) ] [ [ c (con integer 2) ] n ] - ] - ) - ) - ) - ] - ] - [ - [ - c - [ - { build (con integer) } - (abs - a - (type) - (lam - c - (fun (con integer) (fun a a)) - (lam - n - a - [ - [ c (con integer 3) ] - [ [ c (con integer 4) ] n ] - ] - ) - ) - ) - ] - ] - n - ] - ] - ) - ) - ) - ] - ] - ) - ) -) \ No newline at end of file + (letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + ~`$fFoldableList_$cfoldr` : all a b. (a -> b -> b) -> b -> List a -> b + = /\a b -> + \(f : a -> b -> b) -> + let + !f : a -> b -> b = f + in + \(z : b) -> + let + !z : b = z + in + letrec + ~go : List a -> b + = \(ds : List a) -> + List_match + {a} + ds + {all dead. b} + (/\dead -> z) + (\(x : a) (xs : List a) -> /\dead -> f x (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + ~`$fFoldableList` : + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) List + = `$fFoldableList_$cfoldr` + ~build : all a. (all b. (a -> b -> b) -> b -> b) -> List a + = /\a -> + \(g : all b. (a -> b -> b) -> b -> b) -> + g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) + ~concat : + all (t :: * -> *) a. + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) t -> + t (List a) -> + List a + = /\(t :: * -> *) a -> + \(`$dFoldable` : + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) t) + (xs : t (List a)) -> + let + !xs : t (List a) = xs + in + build + {a} + (/\b -> + \(c : a -> b -> b) -> + let + !c : a -> b -> b = c + in + \(n : b) -> + let + !n : b = n + in + `$dFoldable` + {List a} + {b} + (\(x : List a) -> + let + !x : List a = x + in + \(y : b) -> + let + !y : b = y + in + letrec + ~go : List a -> b + = \(ds : List a) -> + List_match + {a} + ds + {all dead. b} + (/\dead -> y) + (\(x : a) (xs : List a) -> + /\dead -> c x (go xs)) + {all dead. dead} + in + go x) + n + xs) + in + concat + {List} + {integer} + `$fFoldableList` + (build + {List integer} + (/\a -> + \(c : List integer -> a -> a) (n : a) -> + c + (build + {integer} + (/\a -> \(c : integer -> a -> a) (n : a) -> c 1 (c 2 n))) + (c + (build + {integer} + (/\a -> \(c : integer -> a -> a) (n : a) -> c 3 (c 4 n))) + n)))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/defaultMethods.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/defaultMethods.pir.golden index 1b821ef142f..217841ad939 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/defaultMethods.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/defaultMethods.pir.golden @@ -1,108 +1,36 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl DefaultMethods (fun (type) (type))) - (tyvardecl a (type)) - DefaultMethods_match - (vardecl - CConsDefaultMethods - (fun - (fun a (con integer)) - (fun (fun a (con integer)) [ DefaultMethods a ]) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - method (all a (type) (fun [ DefaultMethods a ] (fun a (con integer)))) - ) - (abs - a - (type) - (lam - v - [ DefaultMethods a ] - [ - { [ { DefaultMethods_match a } v ] (fun a (con integer)) } - (lam v (fun a (con integer)) (lam v (fun a (con integer)) v)) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - f (all a (type) (fun [ DefaultMethods a ] (fun a (con integer)))) - ) - (abs - a - (type) - (lam - `$dDefaultMethods` - [ DefaultMethods a ] - (lam - a - a - (let - (nonrec) - (termbind (strict) (vardecl a a) a) - [ [ { method a } `$dDefaultMethods` ] a ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fDefaultMethodsInteger_$cmethod` (fun (con integer) (con integer)) - ) - (lam a (con integer) a) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl - `$fDefaultMethodsInteger_$cmethod` (fun (con integer) (con integer)) - ) - (lam - a - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl a (con integer)) a) - [ [ addInteger a ] (con integer 1) ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl `$fDefaultMethodsInteger` [ DefaultMethods (con integer) ]) - [ - [ - { CConsDefaultMethods (con integer) } + data (DefaultMethods :: * -> *) a | DefaultMethods_match where + CConsDefaultMethods : (a -> integer) -> (a -> integer) -> DefaultMethods a + ~method : all a. DefaultMethods a -> a -> integer + = /\a -> + \(v : DefaultMethods a) -> + DefaultMethods_match + {a} + v + {a -> integer} + (\(v : a -> integer) (v : a -> integer) -> v) + ~f : all a. DefaultMethods a -> a -> integer + = /\a -> + \(`$dDefaultMethods` : DefaultMethods a) (a : a) -> + let + !a : a = a + in + method {a} `$dDefaultMethods` a + ~`$fDefaultMethodsInteger_$cmethod` : integer -> integer + = \(a : integer) -> a + !addInteger : integer -> integer -> integer = addInteger + ~`$fDefaultMethodsInteger_$cmethod` : integer -> integer + = \(a : integer) -> let !a : integer = a in addInteger a 1 + ~`$fDefaultMethodsInteger` : DefaultMethods integer + = CConsDefaultMethods + {integer} `$fDefaultMethodsInteger_$cmethod` - ] - `$fDefaultMethodsInteger_$cmethod` - ] - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ [ { f (con integer) } `$fDefaultMethodsInteger` ] ds ] - ) - ) - ) -) \ No newline at end of file + `$fDefaultMethodsInteger_$cmethod` + in + \(ds : integer) -> + let + !ds : integer = ds + in + f {integer} `$fDefaultMethodsInteger` ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/fmapDefaultTest.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/fmapDefaultTest.pir.golden index 542ba6ca065..4c6d50985cf 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/fmapDefaultTest.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/fmapDefaultTest.pir.golden @@ -1,884 +1,209 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind (nonstrict) (vardecl v (con integer)) (con integer 1)) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fAdditiveSemigroupInteger` - [ (lam a (type) (fun a (fun a a))) (con integer) ] - ) - addInteger - ) - (termbind - (nonstrict) - (vardecl - `+` - (all - a - (type) - (fun [ (lam a (type) (fun a (fun a a))) a ] (fun a (fun a a))) - ) - ) - (abs a (type) (lam v [ (lam a (type) (fun a (fun a a))) a ] v)) - ) - (termbind - (nonstrict) - (vardecl v (fun (con integer) (fun (con integer) (con integer)))) - [ { `+` (con integer) } `$fAdditiveSemigroupInteger` ] - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl - `$fFoldableList_$cfoldr` - (all - a - (type) - (all b (type) (fun (fun a (fun b b)) (fun b (fun [ List a ] b)))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a (fun b b)) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a (fun b b))) f) - (lam - z - b - (let - (nonrec) - (termbind (strict) (vardecl z b) z) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] b)) - (lam - ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] (all dead (type) b) - } - (abs dead (type) z) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs dead (type) [ [ f x ] [ go xs ] ]) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fFunctorList_$cfmap` - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ List a ] [ List b ]))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a b) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a b)) f) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] [ List b ])) - (lam + ~v : integer = 1 + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + ~`$fAdditiveSemigroupInteger` : (\a -> a -> a -> a) integer = addInteger + ~`+` : all a. (\a -> a -> a -> a) a -> a -> a -> a + = /\a -> \(v : (\a -> a -> a -> a) a) -> v + ~v : integer -> integer -> integer + = `+` {integer} `$fAdditiveSemigroupInteger` + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + ~`$fFoldableList_$cfoldr` : all a b. (a -> b -> b) -> b -> List a -> b + = /\a b -> + \(f : a -> b -> b) -> + let + !f : a -> b -> b = f + in + \(z : b) -> + let + !z : b = z + in + letrec + ~go : List a -> b + = \(ds : List a) -> + List_match + {a} ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] - (all dead (type) [ List b ]) - } - (abs dead (type) { Nil b }) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs - dead - (type) - [ [ { Cons b } [ f x ] ] [ go xs ] ] - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Applicative (fun (fun (type) (type)) (type))) - (tyvardecl f (fun (type) (type))) + {all dead. b} + (/\dead -> z) + (\(x : a) (xs : List a) -> /\dead -> f x (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + ~`$fFunctorList_$cfmap` : all a b. (a -> b) -> List a -> List b + = /\a b -> + \(f : a -> b) -> + let + !f : a -> b = f + in + letrec + ~go : List a -> List b + = \(ds : List a) -> + List_match + {a} + ds + {all dead. List b} + (/\dead -> Nil {b}) + (\(x : a) (xs : List a) -> + /\dead -> Cons {b} (f x) (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + data (Applicative :: (* -> *) -> *) (f :: * -> *) | Applicative_match where + CConsApplicative : + (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f -> + (all a. a -> f a) -> + (all a b. f (a -> b) -> f a -> f b) -> + Applicative f + ~`$p1Applicative` : + all (f :: * -> *). + Applicative f -> (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f + = /\(f :: * -> *) -> + \(v : Applicative f) -> Applicative_match - (vardecl - CConsApplicative - (fun - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (fun - (all a (type) (fun a [ f a ])) - (fun - (all - a - (type) - (all b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ]))) - ) - [ Applicative f ] - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$p1Applicative` - (all - f - (fun (type) (type)) - (fun - [ Applicative f ] - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - ) - ) - ) - (abs - f - (fun (type) (type)) - (lam + {f} v - [ Applicative f ] - [ - { - [ { Applicative_match f } v ] - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - } - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (lam - v - (all a (type) (fun a [ f a ])) - (lam - v - (all - a - (type) - (all - b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ])) - ) - ) - v - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `<*>` - (all - f - (fun (type) (type)) - (fun - [ Applicative f ] - (all - a - (type) - (all b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ]))) - ) - ) - ) - ) - (abs - f - (fun (type) (type)) - (lam + {(\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f} + (\(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f) + (v : all a. a -> f a) + (v : all a b. f (a -> b) -> f a -> f b) -> + v) + ~`<*>` : + all (f :: * -> *). Applicative f -> (all a b. f (a -> b) -> f a -> f b) + = /\(f :: * -> *) -> + \(v : Applicative f) -> + Applicative_match + {f} v - [ Applicative f ] - [ - { - [ { Applicative_match f } v ] - (all - a - (type) - (all b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ]))) - ) - } - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (lam - v - (all a (type) (fun a [ f a ])) - (lam - v - (all - a - (type) - (all - b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ])) - ) - ) - v - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - pure - (all - f - (fun (type) (type)) - (fun [ Applicative f ] (all a (type) (fun a [ f a ]))) - ) - ) - (abs - f - (fun (type) (type)) - (lam + {all a b. f (a -> b) -> f a -> f b} + (\(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f) + (v : all a. a -> f a) + (v : all a b. f (a -> b) -> f a -> f b) -> + v) + ~pure : all (f :: * -> *). Applicative f -> (all a. a -> f a) + = /\(f :: * -> *) -> + \(v : Applicative f) -> + Applicative_match + {f} v - [ Applicative f ] - [ - { [ { Applicative_match f } v ] (all a (type) (fun a [ f a ])) } - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (lam - v - (all a (type) (fun a [ f a ])) - (lam - v - (all - a - (type) - (all - b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ])) - ) - ) - v - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fTraversableList_$ctraverse` - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ List a ] [ f [ List b ] ])) - ) - ) - ) - ) - ) - (abs - f - (fun (type) (type)) - (abs - a - (type) - (abs - b - (type) - (lam - `$dApplicative` - [ Applicative f ] - (lam - f - (fun a [ f b ]) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a [ f b ])) f) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] [ f [ List b ] ])) - (lam - ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] - (all dead (type) [ f [ List b ] ]) - } - (abs - dead - (type) - [ - { - [ { pure f } `$dApplicative` ] - [ List b ] - } - { Nil b } - ] - ) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs - dead - (type) - (let - (nonrec) - (termbind - (strict) (vardecl x [ f b ]) [ f x ] - ) - [ - [ - { - { - [ { `<*>` f } `$dApplicative` ] - [ List b ] - } - [ List b ] - } - [ - [ - { - { - [ - { `$p1Applicative` f } - `$dApplicative` - ] - b - } - (fun [ List b ] [ List b ]) - } - (lam - ds - b - (lam - ds - [ List b ] - [ [ { Cons b } ds ] ds ] - ) - ) - ] - x - ] - ] - [ go xs ] - ] - ) - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Traversable (fun (fun (type) (type)) (type))) - (tyvardecl t (fun (type) (type))) + {all a. a -> f a} + (\(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f) + (v : all a. a -> f a) + (v : all a b. f (a -> b) -> f a -> f b) -> + v) + ~`$fTraversableList_$ctraverse` : + all (f :: * -> *) a b. + Applicative f -> (a -> f b) -> List a -> f (List b) + = /\(f :: * -> *) a b -> + \(`$dApplicative` : Applicative f) (f : a -> f b) -> + let + !f : a -> f b = f + in + letrec + ~go : List a -> f (List b) + = \(ds : List a) -> + List_match + {a} + ds + {all dead. f (List b)} + (/\dead -> pure {f} `$dApplicative` {List b} (Nil {b})) + (\(x : a) (xs : List a) -> + /\dead -> + let + !x : f b = f x + in + `<*>` + {f} + `$dApplicative` + {List b} + {List b} + (`$p1Applicative` + {f} + `$dApplicative` + {b} + {List b -> List b} + (\(ds : b) (ds : List b) -> Cons {b} ds ds) + x) + (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + data (Traversable :: (* -> *) -> *) (t :: * -> *) | Traversable_match where + CConsTraversable : + (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) t -> + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) t -> + (all (f :: * -> *) a b. + Applicative f -> (a -> f b) -> t a -> f (t b)) -> + Traversable t + ~`$fTraversableList` : Traversable List + = CConsTraversable + {List} + `$fFunctorList_$cfmap` + `$fFoldableList_$cfoldr` + `$fTraversableList_$ctraverse` + ~build : all a. (all b. (a -> b -> b) -> b -> b) -> List a + = /\a -> + \(g : all b. (a -> b -> b) -> b -> b) -> + g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) + ~`$fApplicativeIdentity_$cpure` : all a. a -> (\a -> a) a + = /\a -> \(ds : a) -> ds + ~id : all a. a -> a = /\a -> \(x : a) -> x + ~`$fApplicativeIdentity` : Applicative (\a -> a) + = CConsApplicative + {\a -> a} + (/\a b -> id {a -> b}) + `$fApplicativeIdentity_$cpure` + (/\a b -> id {a -> b}) + ~traverse : + all (t :: * -> *). + Traversable t -> + (all (f :: * -> *) a b. Applicative f -> (a -> f b) -> t a -> f (t b)) + = /\(t :: * -> *) -> + \(v : Traversable t) -> Traversable_match - (vardecl - CConsTraversable - (fun - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - t - ] - (fun - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun (fun a (fun b b)) (fun b (fun [ t a ] b))) - ) - ) - ) - t - ] - (fun - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ t a ] [ f [ t b ] ])) - ) - ) - ) - ) - [ Traversable t ] - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl `$fTraversableList` [ Traversable List ]) - [ - [ - [ { CConsTraversable List } `$fFunctorList_$cfmap` ] - `$fFoldableList_$cfoldr` - ] - `$fTraversableList_$ctraverse` - ] - ) - (termbind - (nonstrict) - (vardecl - build - (all - a - (type) - (fun (all b (type) (fun (fun a (fun b b)) (fun b b))) [ List a ]) - ) - ) - (abs - a - (type) - (lam - g - (all b (type) (fun (fun a (fun b b)) (fun b b))) - [ - [ - { g [ List a ] } - (lam ds a (lam ds [ List a ] [ [ { Cons a } ds ] ds ])) - ] - { Nil a } - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fApplicativeIdentity_$cpure` - (all a (type) (fun a [ (lam a (type) a) a ])) - ) - (abs a (type) (lam ds a ds)) - ) - (termbind - (nonstrict) - (vardecl id (all a (type) (fun a a))) - (abs a (type) (lam x a x)) - ) - (termbind - (nonstrict) - (vardecl `$fApplicativeIdentity` [ Applicative (lam a (type) a) ]) - [ - [ - [ - { CConsApplicative (lam a (type) a) } - (abs a (type) (abs b (type) { id (fun a b) })) - ] - `$fApplicativeIdentity_$cpure` - ] - (abs a (type) (abs b (type) { id (fun a b) })) - ] - ) - (termbind - (nonstrict) - (vardecl - traverse - (all - t - (fun (type) (type)) - (fun - [ Traversable t ] - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ t a ] [ f [ t b ] ])) - ) - ) - ) - ) - ) - ) - ) - (abs - t - (fun (type) (type)) - (lam + {t} v - [ Traversable t ] - [ - { - [ { Traversable_match t } v ] - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ t a ] [ f [ t b ] ])) - ) - ) - ) - ) - } - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - t - ] - (lam - v - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun (fun a (fun b b)) (fun b (fun [ t a ] b))) - ) - ) - ) - t - ] - (lam - v - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ t a ] [ f [ t b ] ])) - ) - ) - ) - ) - v - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - fmapDefault - (all - t - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun [ Traversable t ] (fun (fun a b) (fun [ t a ] [ t b ]))) - ) - ) - ) - ) - (abs - t - (fun (type) (type)) - (abs - a - (type) - (abs - b - (type) - (lam - `$dTraversable` - [ Traversable t ] - [ - { - { - { [ { traverse t } `$dTraversable` ] (lam a (type) a) } - a - } - b - } - `$fApplicativeIdentity` - ] - ) - ) - ) - ) - ) - [ - [ - [ - { { { fmapDefault List } (con integer) } (con integer) } - `$fTraversableList` - ] - (lam v (con integer) [ [ v v ] v ]) - ] - [ - { build (con integer) } - (abs - a - (type) - (lam - c - (fun (con integer) (fun a a)) - (lam - n - a - [ - [ c (con integer 1) ] - [ - [ c (con integer 2) ] - [ [ c (con integer 3) ] [ [ c (con integer 4) ] n ] ] - ] - ] - ) - ) - ) - ] - ] - ) - ) - ) -) \ No newline at end of file + {all (f :: * -> *) a b. + Applicative f -> (a -> f b) -> t a -> f (t b)} + (\(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) t) + (v : + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) + t) + (v : + all (f :: * -> *) a b. + Applicative f -> (a -> f b) -> t a -> f (t b)) -> + v) + ~fmapDefault : + all (t :: * -> *) a b. Traversable t -> (a -> b) -> t a -> t b + = /\(t :: * -> *) a b -> + \(`$dTraversable` : Traversable t) -> + traverse + {t} + `$dTraversable` + {\a -> a} + {a} + {b} + `$fApplicativeIdentity` + in + fmapDefault + {List} + {integer} + {integer} + `$fTraversableList` + (\(v : integer) -> v v v) + (build + {integer} + (/\a -> \(c : integer -> a -> a) (n : a) -> c 1 (c 2 (c 3 (c 4 n)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden index 480c779c5c1..4dad97a8f09 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/multiFunction.pir.golden @@ -1,219 +1,79 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Animal (type)) - - Animal_match - (vardecl Cat Animal) (vardecl Dog Animal) - ) - ) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (datatypebind - (datatype - (tyvardecl PersonLike (fun (type) (type))) - (tyvardecl a (type)) - PersonLike_match - (vardecl - CConsPersonLike - (fun - (fun a (con integer)) - (fun (fun a (fun Animal Bool)) [ PersonLike a ]) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl age (all a (type) (fun [ PersonLike a ] (fun a (con integer))))) - (abs - a - (type) - (lam - v - [ PersonLike a ] - [ - { [ { PersonLike_match a } v ] (fun a (con integer)) } - (lam v (fun a (con integer)) (lam v (fun a (fun Animal Bool)) v)) - ] - ) - ) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (strict) - (vardecl - lessThanInteger (fun (con integer) (fun (con integer) (con bool))) - ) - (builtin lessThanInteger) - ) - (termbind - (nonstrict) - (vardecl lessThanInteger (fun (con integer) (fun (con integer) Bool))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - (termbind - (strict) (vardecl b (con bool)) [ [ lessThanInteger x ] y ] - ) - [ [ [ { ifThenElse Bool } b ] True ] False ] - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - likesAnimal - (all a (type) (fun [ PersonLike a ] (fun a (fun Animal Bool)))) - ) - (abs - a - (type) - (lam - v - [ PersonLike a ] - [ - { [ { PersonLike_match a } v ] (fun a (fun Animal Bool)) } - (lam v (fun a (con integer)) (lam v (fun a (fun Animal Bool)) v)) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl predicate (all p (type) (fun [ PersonLike p ] (fun p Bool)))) - (abs - p - (type) - (lam - `$dPersonLike` - [ PersonLike p ] - (lam - p - p - (let - (nonrec) - (termbind (strict) (vardecl p p) p) - { - [ - [ - { - [ - Bool_match - [ [ [ { likesAnimal p } `$dPersonLike` ] p ] Cat ] - ] - (all dead (type) Bool) - } - (abs - dead - (type) - [ - [ lessThanInteger [ [ { age p } `$dPersonLike` ] p ] ] - (con integer 30) - ] - ) - ] - (abs dead (type) False) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Person (type)) - - Person_match - (vardecl Jane Person) (vardecl Jim Person) - ) - ) - (termbind - (nonstrict) - (vardecl `$cage` (fun Person (con integer))) - (lam - ds - Person - [ - [ { [ Person_match ds ] (con integer) } (con integer 35) ] - (con integer 30) - ] - ) - ) - (termbind - (nonstrict) - (vardecl `$clikesAnimal` (fun Person (fun Animal Bool))) - (lam - ds - Person - (lam - ds - Animal - { - [ - [ - { [ Person_match ds ] (all dead (type) Bool) } - (abs - dead - (type) - { - [ - [ - { [ Animal_match ds ] (all dead (type) Bool) } - (abs dead (type) True) - ] - (abs dead (type) False) - ] - (all dead (type) dead) - } - ) - ] - (abs dead (type) False) - ] - (all dead (type) dead) - } - ) - ) - ) - (termbind - (nonstrict) - (vardecl `$fPersonLikePerson` [ PersonLike Person ]) - [ [ { CConsPersonLike Person } `$cage` ] `$clikesAnimal` ] - ) - (lam - ds - Person - (let - (nonrec) - (termbind (strict) (vardecl ds Person) ds) - [ [ { predicate Person } `$fPersonLikePerson` ] ds ] - ) - ) - ) -) \ No newline at end of file + data Animal | Animal_match where + Cat : Animal + Dog : Animal + data Bool | Bool_match where + True : Bool + False : Bool + data (PersonLike :: * -> *) a | PersonLike_match where + CConsPersonLike : (a -> integer) -> (a -> Animal -> Bool) -> PersonLike a + ~age : all a. PersonLike a -> a -> integer + = /\a -> + \(v : PersonLike a) -> + PersonLike_match + {a} + v + {a -> integer} + (\(v : a -> integer) (v : a -> Animal -> Bool) -> v) + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !lessThanInteger : integer -> integer -> bool = lessThanInteger + ~lessThanInteger : integer -> integer -> Bool + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> + let + !y : integer = y + !b : bool = lessThanInteger x y + in + ifThenElse {Bool} b True False + ~likesAnimal : all a. PersonLike a -> a -> Animal -> Bool + = /\a -> + \(v : PersonLike a) -> + PersonLike_match + {a} + v + {a -> Animal -> Bool} + (\(v : a -> integer) (v : a -> Animal -> Bool) -> v) + ~predicate : all p. PersonLike p -> p -> Bool + = /\p -> + \(`$dPersonLike` : PersonLike p) (p : p) -> + let + !p : p = p + in + Bool_match + (likesAnimal {p} `$dPersonLike` p Cat) + {all dead. Bool} + (/\dead -> lessThanInteger (age {p} `$dPersonLike` p) 30) + (/\dead -> False) + {all dead. dead} + data Person | Person_match where + Jane : Person + Jim : Person + ~`$cage` : Person -> integer + = \(ds : Person) -> Person_match ds {integer} 35 30 + ~`$clikesAnimal` : Person -> Animal -> Bool + = \(ds : Person) (ds : Animal) -> + Person_match + ds + {all dead. Bool} + (/\dead -> + Animal_match + ds + {all dead. Bool} + (/\dead -> True) + (/\dead -> False) + {all dead. dead}) + (/\dead -> False) + {all dead. dead} + ~`$fPersonLikePerson` : PersonLike Person + = CConsPersonLike {Person} `$cage` `$clikesAnimal` + in + \(ds : Person) -> + let + !ds : Person = ds + in + predicate {Person} `$fPersonLikePerson` ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden index bf1d7fd84fe..23bb296c13c 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/partialApplication.pir.golden @@ -1,108 +1,40 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Bool (type)) - - Bool_match - (vardecl True Bool) (vardecl False Bool) - ) - ) - (datatypebind - (datatype - (tyvardecl Ordering (type)) - - Ordering_match - (vardecl EQ Ordering) (vardecl GT Ordering) (vardecl LT Ordering) - ) - ) - (termbind - (strict) - (vardecl equalsInteger (fun (con integer) (fun (con integer) (con bool)))) - (builtin equalsInteger) - ) - (termbind - (strict) - (vardecl ifThenElse (all a (type) (fun (con bool) (fun a (fun a a))))) - (builtin ifThenElse) - ) - (termbind - (strict) - (vardecl - lessThanEqualsInteger (fun (con integer) (fun (con integer) (con bool))) - ) - (builtin lessThanEqualsInteger) - ) - (termbind - (nonstrict) - (vardecl - `$fOrdInteger_$ccompare` - (fun (con integer) (fun (con integer) Ordering)) - ) - (lam - eta - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) eta) - (lam - eta - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) eta) - (termbind - (strict) (vardecl b (con bool)) [ [ equalsInteger x ] y ] - ) - { - [ - [ - { - [ - Bool_match [ [ [ { ifThenElse Bool } b ] True ] False ] - ] - (all dead (type) Ordering) - } - (abs dead (type) EQ) - ] - (abs - dead - (type) - (let - (nonrec) - (termbind - (strict) - (vardecl b (con bool)) - [ [ lessThanEqualsInteger x ] y ] - ) - { - [ - [ - { - [ - Bool_match - [ [ [ { ifThenElse Bool } b ] True ] False ] - ] - (all dead (type) Ordering) - } - (abs dead (type) LT) - ] - (abs dead (type) GT) - ] - (all dead (type) dead) - } - ) - ) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - `$fOrdInteger_$ccompare` - ) -) \ No newline at end of file + data Bool | Bool_match where + True : Bool + False : Bool + data Ordering | Ordering_match where + EQ : Ordering + GT : Ordering + LT : Ordering + !equalsInteger : integer -> integer -> bool = equalsInteger + !ifThenElse : all a. bool -> a -> a -> a = ifThenElse + !lessThanEqualsInteger : integer -> integer -> bool = lessThanEqualsInteger + ~`$fOrdInteger_$ccompare` : integer -> integer -> Ordering + = \(eta : integer) -> + let + !x : integer = eta + in + \(eta : integer) -> + let + !y : integer = eta + !b : bool = equalsInteger x y + in + Bool_match + (ifThenElse {Bool} b True False) + {all dead. Ordering} + (/\dead -> EQ) + (/\dead -> + let + !b : bool = lessThanEqualsInteger x y + in + Bool_match + (ifThenElse {Bool} b True False) + {all dead. Ordering} + (/\dead -> LT) + (/\dead -> GT) + {all dead. dead}) + {all dead. dead} + in + `$fOrdInteger_$ccompare`) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sequenceTest.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sequenceTest.pir.golden index 723765c24b5..1c30e916b20 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sequenceTest.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sequenceTest.pir.golden @@ -1,937 +1,236 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Maybe (fun (type) (type))) - (tyvardecl a (type)) - Maybe_match - (vardecl Just (fun a [ Maybe a ])) (vardecl Nothing [ Maybe a ]) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fApplicativeMaybe_$c<*>` - (all - a - (type) - (all b (type) (fun [ Maybe (fun a b) ] (fun [ Maybe a ] [ Maybe b ]))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - ds - [ Maybe (fun a b) ] - (lam + data (Maybe :: * -> *) a | Maybe_match where + Just : a -> Maybe a + Nothing : Maybe a + ~`$fApplicativeMaybe_$c<*>` : all a b. Maybe (a -> b) -> Maybe a -> Maybe b + = /\a b -> + \(ds : Maybe (a -> b)) (ds : Maybe a) -> + Maybe_match + {a -> b} ds - [ Maybe a ] - { - [ - [ - { - [ { Maybe_match (fun a b) } ds ] - (all dead (type) [ Maybe b ]) - } - (lam - ipv - (fun a b) - (abs - dead - (type) - { - [ - [ - { - [ { Maybe_match a } ds ] - (all dead (type) [ Maybe b ]) - } - (lam - ipv - a - (abs dead (type) [ { Just b } [ ipv ipv ] ]) - ) - ] - (abs dead (type) { Nothing b }) - ] - (all dead (type) dead) - } - ) - ) - ] - (abs dead (type) { Nothing b }) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl `$fApplicativeMaybe_$cpure` (all a (type) (fun a [ Maybe a ]))) - (abs a (type) (lam ds a [ { Just a } ds ])) - ) - (termbind - (nonstrict) - (vardecl - `$fFunctorMaybe_$cfmap` - (all - a (type) (all b (type) (fun (fun a b) (fun [ Maybe a ] [ Maybe b ]))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a b) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a b)) f) - (lam + {all dead. Maybe b} + (\(ipv : a -> b) -> + /\dead -> + Maybe_match + {a} + ds + {all dead. Maybe b} + (\(ipv : a) -> /\dead -> Just {b} (ipv ipv)) + (/\dead -> Nothing {b}) + {all dead. dead}) + (/\dead -> Nothing {b}) + {all dead. dead} + ~`$fApplicativeMaybe_$cpure` : all a. a -> Maybe a + = /\a -> \(ds : a) -> Just {a} ds + ~`$fFunctorMaybe_$cfmap` : all a b. (a -> b) -> Maybe a -> Maybe b + = /\a b -> + \(f : a -> b) -> + let + !f : a -> b = f + in + \(ds : Maybe a) -> + Maybe_match + {a} ds - [ Maybe a ] - { - [ - [ - { [ { Maybe_match a } ds ] (all dead (type) [ Maybe b ]) } - (lam a a (abs dead (type) [ { Just b } [ f a ] ])) - ] - (abs dead (type) { Nothing b }) - ] - (all dead (type) dead) - } - ) - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Applicative (fun (fun (type) (type)) (type))) - (tyvardecl f (fun (type) (type))) - Applicative_match - (vardecl - CConsApplicative - (fun - [ - (lam - f - (fun (type) (type)) - (all - a (type) (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (fun - (all a (type) (fun a [ f a ])) - (fun - (all - a - (type) - (all b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ]))) - ) - [ Applicative f ] - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl `$fApplicativeMaybe` [ Applicative Maybe ]) - [ - [ - [ { CConsApplicative Maybe } `$fFunctorMaybe_$cfmap` ] + {all dead. Maybe b} + (\(a : a) -> /\dead -> Just {b} (f a)) + (/\dead -> Nothing {b}) + {all dead. dead} + data (Applicative :: (* -> *) -> *) (f :: * -> *) | Applicative_match where + CConsApplicative : + (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f -> + (all a. a -> f a) -> + (all a b. f (a -> b) -> f a -> f b) -> + Applicative f + ~`$fApplicativeMaybe` : Applicative Maybe + = CConsApplicative + {Maybe} + `$fFunctorMaybe_$cfmap` `$fApplicativeMaybe_$cpure` - ] - `$fApplicativeMaybe_$c<*>` - ] - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl - `$fFoldableList_$cfoldr` - (all - a - (type) - (all b (type) (fun (fun a (fun b b)) (fun b (fun [ List a ] b)))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a (fun b b)) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a (fun b b))) f) - (lam - z - b - (let - (nonrec) - (termbind (strict) (vardecl z b) z) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] b)) - (lam - ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] (all dead (type) b) - } - (abs dead (type) z) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs dead (type) [ [ f x ] [ go xs ] ]) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fFunctorList_$cfmap` - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ List a ] [ List b ]))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a b) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a b)) f) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] [ List b ])) - (lam + `$fApplicativeMaybe_$c<*>` + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + ~`$fFoldableList_$cfoldr` : all a b. (a -> b -> b) -> b -> List a -> b + = /\a b -> + \(f : a -> b -> b) -> + let + !f : a -> b -> b = f + in + \(z : b) -> + let + !z : b = z + in + letrec + ~go : List a -> b + = \(ds : List a) -> + List_match + {a} ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] - (all dead (type) [ List b ]) - } - (abs dead (type) { Nil b }) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs - dead - (type) - [ [ { Cons b } [ f x ] ] [ go xs ] ] - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$p1Applicative` - (all - f - (fun (type) (type)) - (fun - [ Applicative f ] - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - ) - ) - ) - (abs - f - (fun (type) (type)) - (lam + {all dead. b} + (/\dead -> z) + (\(x : a) (xs : List a) -> /\dead -> f x (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + ~`$fFunctorList_$cfmap` : all a b. (a -> b) -> List a -> List b + = /\a b -> + \(f : a -> b) -> + let + !f : a -> b = f + in + letrec + ~go : List a -> List b + = \(ds : List a) -> + List_match + {a} + ds + {all dead. List b} + (/\dead -> Nil {b}) + (\(x : a) (xs : List a) -> + /\dead -> Cons {b} (f x) (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + ~`$p1Applicative` : + all (f :: * -> *). + Applicative f -> (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f + = /\(f :: * -> *) -> + \(v : Applicative f) -> + Applicative_match + {f} v - [ Applicative f ] - [ - { - [ { Applicative_match f } v ] - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - } - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (lam - v - (all a (type) (fun a [ f a ])) - (lam - v - (all - a - (type) - (all - b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ])) - ) - ) - v - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `<*>` - (all - f - (fun (type) (type)) - (fun - [ Applicative f ] - (all - a - (type) - (all b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ]))) - ) - ) - ) - ) - (abs - f - (fun (type) (type)) - (lam + {(\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f} + (\(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f) + (v : all a. a -> f a) + (v : all a b. f (a -> b) -> f a -> f b) -> + v) + ~`<*>` : + all (f :: * -> *). Applicative f -> (all a b. f (a -> b) -> f a -> f b) + = /\(f :: * -> *) -> + \(v : Applicative f) -> + Applicative_match + {f} v - [ Applicative f ] - [ - { - [ { Applicative_match f } v ] - (all - a - (type) - (all b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ]))) - ) - } - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (lam - v - (all a (type) (fun a [ f a ])) - (lam - v - (all - a - (type) - (all - b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ])) - ) - ) - v - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - pure - (all - f - (fun (type) (type)) - (fun [ Applicative f ] (all a (type) (fun a [ f a ]))) - ) - ) - (abs - f - (fun (type) (type)) - (lam + {all a b. f (a -> b) -> f a -> f b} + (\(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f) + (v : all a. a -> f a) + (v : all a b. f (a -> b) -> f a -> f b) -> + v) + ~pure : all (f :: * -> *). Applicative f -> (all a. a -> f a) + = /\(f :: * -> *) -> + \(v : Applicative f) -> + Applicative_match + {f} v - [ Applicative f ] - [ - { [ { Applicative_match f } v ] (all a (type) (fun a [ f a ])) } - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - f - ] - (lam - v - (all a (type) (fun a [ f a ])) - (lam - v - (all - a - (type) - (all - b (type) (fun [ f (fun a b) ] (fun [ f a ] [ f b ])) - ) - ) - v - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fTraversableList_$ctraverse` - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ List a ] [ f [ List b ] ])) - ) - ) - ) - ) - ) - (abs - f - (fun (type) (type)) - (abs - a - (type) - (abs - b - (type) - (lam - `$dApplicative` - [ Applicative f ] - (lam - f - (fun a [ f b ]) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a [ f b ])) f) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] [ f [ List b ] ])) - (lam - ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] - (all dead (type) [ f [ List b ] ]) - } - (abs - dead - (type) - [ - { - [ { pure f } `$dApplicative` ] - [ List b ] - } - { Nil b } - ] - ) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs - dead - (type) - (let - (nonrec) - (termbind - (strict) (vardecl x [ f b ]) [ f x ] - ) - [ - [ - { - { - [ { `<*>` f } `$dApplicative` ] - [ List b ] - } - [ List b ] - } - [ - [ - { - { - [ - { `$p1Applicative` f } - `$dApplicative` - ] - b - } - (fun [ List b ] [ List b ]) - } - (lam - ds - b - (lam - ds - [ List b ] - [ [ { Cons b } ds ] ds ] - ) - ) - ] - x - ] - ] - [ go xs ] - ] - ) - ) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl Traversable (fun (fun (type) (type)) (type))) - (tyvardecl t (fun (type) (type))) + {all a. a -> f a} + (\(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) f) + (v : all a. a -> f a) + (v : all a b. f (a -> b) -> f a -> f b) -> + v) + ~`$fTraversableList_$ctraverse` : + all (f :: * -> *) a b. + Applicative f -> (a -> f b) -> List a -> f (List b) + = /\(f :: * -> *) a b -> + \(`$dApplicative` : Applicative f) (f : a -> f b) -> + let + !f : a -> f b = f + in + letrec + ~go : List a -> f (List b) + = \(ds : List a) -> + List_match + {a} + ds + {all dead. f (List b)} + (/\dead -> pure {f} `$dApplicative` {List b} (Nil {b})) + (\(x : a) (xs : List a) -> + /\dead -> + let + !x : f b = f x + in + `<*>` + {f} + `$dApplicative` + {List b} + {List b} + (`$p1Applicative` + {f} + `$dApplicative` + {b} + {List b -> List b} + (\(ds : b) (ds : List b) -> Cons {b} ds ds) + x) + (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + data (Traversable :: (* -> *) -> *) (t :: * -> *) | Traversable_match where + CConsTraversable : + (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) t -> + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) t -> + (all (f :: * -> *) a b. + Applicative f -> (a -> f b) -> t a -> f (t b)) -> + Traversable t + ~`$fTraversableList` : Traversable List + = CConsTraversable + {List} + `$fFunctorList_$cfmap` + `$fFoldableList_$cfoldr` + `$fTraversableList_$ctraverse` + ~build : all a. (all b. (a -> b -> b) -> b -> b) -> List a + = /\a -> + \(g : all b. (a -> b -> b) -> b -> b) -> + g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) + ~id : all a. a -> a = /\a -> \(x : a) -> x + ~traverse : + all (t :: * -> *). + Traversable t -> + (all (f :: * -> *) a b. Applicative f -> (a -> f b) -> t a -> f (t b)) + = /\(t :: * -> *) -> + \(v : Traversable t) -> Traversable_match - (vardecl - CConsTraversable - (fun - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - t - ] - (fun - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun (fun a (fun b b)) (fun b (fun [ t a ] b))) - ) - ) - ) - t - ] - (fun - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ t a ] [ f [ t b ] ])) - ) - ) - ) - ) - [ Traversable t ] - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl `$fTraversableList` [ Traversable List ]) - [ - [ - [ { CConsTraversable List } `$fFunctorList_$cfmap` ] - `$fFoldableList_$cfoldr` - ] - `$fTraversableList_$ctraverse` - ] - ) - (termbind - (nonstrict) - (vardecl - build - (all - a - (type) - (fun (all b (type) (fun (fun a (fun b b)) (fun b b))) [ List a ]) - ) - ) - (abs - a - (type) - (lam - g - (all b (type) (fun (fun a (fun b b)) (fun b b))) - [ - [ - { g [ List a ] } - (lam ds a (lam ds [ List a ] [ [ { Cons a } ds ] ds ])) - ] - { Nil a } - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl id (all a (type) (fun a a))) - (abs a (type) (lam x a x)) - ) - (termbind - (nonstrict) - (vardecl - traverse - (all - t - (fun (type) (type)) - (fun - [ Traversable t ] - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ t a ] [ f [ t b ] ])) - ) - ) - ) - ) - ) - ) - ) - (abs - t - (fun (type) (type)) - (lam + {t} v - [ Traversable t ] - [ - { - [ { Traversable_match t } v ] - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ t a ] [ f [ t b ] ])) - ) - ) - ) - ) - } - (lam - v - [ - (lam - f - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a b) (fun [ f a ] [ f b ]))) - ) - ) - t - ] - (lam - v - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun (fun a (fun b b)) (fun b (fun [ t a ] b))) - ) - ) - ) - t - ] - (lam - v - (all - f - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun - [ Applicative f ] - (fun (fun a [ f b ]) (fun [ t a ] [ f [ t b ] ])) - ) - ) - ) - ) - v - ) - ) - ) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - sequence - (all - t - (fun (type) (type)) - (all - f - (fun (type) (type)) - (all - a - (type) - (fun - [ Traversable t ] - (fun [ Applicative f ] (fun [ t [ f a ] ] [ f [ t a ] ])) - ) - ) - ) - ) - ) - (abs - t - (fun (type) (type)) - (abs - f - (fun (type) (type)) - (abs - a - (type) - (lam - `$dTraversable` - [ Traversable t ] - (lam - `$dApplicative` - [ Applicative f ] - [ - [ - { - { { [ { traverse t } `$dTraversable` ] f } [ f a ] } a - } - `$dApplicative` - ] - { id [ f a ] } - ] - ) - ) - ) - ) - ) - ) - [ - [ - [ - { { { sequence List } Maybe } (con integer) } `$fTraversableList` - ] - `$fApplicativeMaybe` - ] - [ - { build [ Maybe (con integer) ] } - (abs - a - (type) - (lam - c - (fun [ Maybe (con integer) ] (fun a a)) - (lam - n - a - [ - [ c [ { Just (con integer) } (con integer 1) ] ] - [ [ c [ { Just (con integer) } (con integer 2) ] ] n ] - ] - ) - ) - ) - ] - ] - ) - ) - ) -) \ No newline at end of file + {all (f :: * -> *) a b. + Applicative f -> (a -> f b) -> t a -> f (t b)} + (\(v : (\(f :: * -> *) -> all a b. (a -> b) -> f a -> f b) t) + (v : + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) + t) + (v : + all (f :: * -> *) a b. + Applicative f -> (a -> f b) -> t a -> f (t b)) -> + v) + ~sequence : + all (t :: * -> *) (f :: * -> *) a. + Traversable t -> Applicative f -> t (f a) -> f (t a) + = /\(t :: * -> *) (f :: * -> *) a -> + \(`$dTraversable` : Traversable t) + (`$dApplicative` : Applicative f) -> + traverse + {t} + `$dTraversable` + {f} + {f a} + {a} + `$dApplicative` + (id {f a}) + in + sequence + {List} + {Maybe} + {integer} + `$fTraversableList` + `$fApplicativeMaybe` + (build + {Maybe integer} + (/\a -> + \(c : Maybe integer -> a -> a) (n : a) -> + c (Just {integer} 1) (c (Just {integer} 2) n)))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sizedBasic.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sizedBasic.pir.golden index e4265904107..a7c54e1ad50 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sizedBasic.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sizedBasic.pir.golden @@ -1,39 +1,13 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (nonstrict) - (vardecl `$csize` (fun (con integer) (con integer))) - (lam x (con integer) x) - ) - (termbind - (nonstrict) - (vardecl - `$fSizedInteger` [ (lam a (type) (fun a (con integer))) (con integer) ] - ) - `$csize` - ) - (termbind - (nonstrict) - (vardecl - size - (all - a - (type) - (fun [ (lam a (type) (fun a (con integer))) a ] (fun a (con integer))) - ) - ) - (abs a (type) (lam v [ (lam a (type) (fun a (con integer))) a ] v)) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ [ { size (con integer) } `$fSizedInteger` ] ds ] - ) - ) - ) -) \ No newline at end of file + ~`$csize` : integer -> integer = \(x : integer) -> x + ~`$fSizedInteger` : (\a -> a -> integer) integer = `$csize` + ~size : all a. (\a -> a -> integer) a -> a -> integer + = /\a -> \(v : (\a -> a -> integer) a) -> v + in + \(ds : integer) -> + let + !ds : integer = ds + in + size {integer} `$fSizedInteger` ds) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sizedPair.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sizedPair.pir.golden index 40b11797d8b..af12b31b5e0 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sizedPair.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sizedPair.pir.golden @@ -1,161 +1,52 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype - (tyvardecl Tuple2 (fun (type) (fun (type) (type)))) - (tyvardecl a (type)) (tyvardecl b (type)) - Tuple2_match - (vardecl Tuple2 (fun a (fun b [ [ Tuple2 a ] b ]))) - ) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl - `$csize` - (all - a - (type) - (all - b - (type) - (fun - [ (lam a (type) (fun a (con integer))) a ] - (fun - [ (lam a (type) (fun a (con integer))) b ] - (fun [ [ Tuple2 a ] b ] (con integer)) - ) - ) - ) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - `$dSized` - [ (lam a (type) (fun a (con integer))) a ] - (lam - `$dSized` - [ (lam a (type) (fun a (con integer))) b ] - (lam - ds - [ [ Tuple2 a ] b ] - [ - { [ { { Tuple2_match a } b } ds ] (con integer) } - (lam - a - a - (lam - b - b - (let - (nonrec) - (termbind - (strict) (vardecl x (con integer)) [ `$dSized` a ] - ) - (termbind - (strict) (vardecl y (con integer)) [ `$dSized` b ] - ) - [ [ addInteger x ] y ] - ) - ) - ) - ] - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fSizedTuple2` - (all - a - (type) - (all - b - (type) - (fun - [ (lam a (type) (fun a (con integer))) a ] - (fun - [ (lam a (type) (fun a (con integer))) b ] - [ (lam a (type) (fun a (con integer))) [ [ Tuple2 a ] b ] ] - ) - ) - ) - ) - ) - `$csize` - ) - (termbind - (nonstrict) - (vardecl `$csize` (fun (con integer) (con integer))) - (lam x (con integer) x) - ) - (termbind - (nonstrict) - (vardecl - `$fSizedInteger` [ (lam a (type) (fun a (con integer))) (con integer) ] - ) - `$csize` - ) - (termbind - (nonstrict) - (vardecl + data (Tuple2 :: * -> * -> *) a b | Tuple2_match where + Tuple2 : a -> b -> Tuple2 a b + !addInteger : integer -> integer -> integer = addInteger + ~`$csize` : + all a b. + (\a -> a -> integer) a -> + (\a -> a -> integer) b -> + Tuple2 a b -> + integer + = /\a b -> + \(`$dSized` : (\a -> a -> integer) a) + (`$dSized` : (\a -> a -> integer) b) + (ds : Tuple2 a b) -> + Tuple2_match + {a} + {b} + ds + {integer} + (\(a : a) (b : b) -> + let + !x : integer = `$dSized` a + !y : integer = `$dSized` b + in + addInteger x y) + ~`$fSizedTuple2` : + all a b. + (\a -> a -> integer) a -> + (\a -> a -> integer) b -> + (\a -> a -> integer) (Tuple2 a b) + = `$csize` + ~`$csize` : integer -> integer = \(x : integer) -> x + ~`$fSizedInteger` : (\a -> a -> integer) integer = `$csize` + ~`$dSized` : (\a -> a -> integer) (Tuple2 integer integer) + = `$fSizedTuple2` {integer} {integer} `$fSizedInteger` `$fSizedInteger` + ~size : all a. (\a -> a -> integer) a -> a -> integer + = /\a -> \(v : (\a -> a -> integer) a) -> v + in + \(ds : integer) -> + let + !ds : integer = ds + in + \(ds : integer) -> + let + !ds : integer = ds + in + size + {Tuple2 integer integer} `$dSized` - [ - (lam a (type) (fun a (con integer))) - [ [ Tuple2 (con integer) ] (con integer) ] - ] - ) - [ - [ { { `$fSizedTuple2` (con integer) } (con integer) } `$fSizedInteger` ] - `$fSizedInteger` - ] - ) - (termbind - (nonstrict) - (vardecl - size - (all - a - (type) - (fun [ (lam a (type) (fun a (con integer))) a ] (fun a (con integer))) - ) - ) - (abs a (type) (lam v [ (lam a (type) (fun a (con integer))) a ] v)) - ) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - (lam - ds - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl ds (con integer)) ds) - [ - [ { size [ [ Tuple2 (con integer) ] (con integer) ] } `$dSized` ] - [ [ { { Tuple2 (con integer) } (con integer) } ds ] ds ] - ] - ) - ) - ) - ) - ) -) \ No newline at end of file + (Tuple2 {integer} {integer} ds ds)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sumTest.pir.golden b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sumTest.pir.golden index 7e88a3e2032..59c4302fcbd 100644 --- a/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sumTest.pir.golden +++ b/plutus-tx-plugin/test/Plugin/Typeclasses/9.6/sumTest.pir.golden @@ -1,324 +1,94 @@ -(program +program 1.1.0 (let - (nonrec) - (termbind - (nonstrict) - (vardecl `$fAdditiveMonoidInteger_$czero` (con integer)) - (con integer 0) - ) - (termbind - (strict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (builtin addInteger) - ) - (termbind - (nonstrict) - (vardecl addInteger (fun (con integer) (fun (con integer) (con integer)))) - (lam - x - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl x (con integer)) x) - (lam - y - (con integer) - (let - (nonrec) - (termbind (strict) (vardecl y (con integer)) y) - [ [ addInteger x ] y ] - ) - ) - ) - ) - ) - (datatypebind - (datatype - (tyvardecl AdditiveMonoid (fun (type) (type))) - (tyvardecl a (type)) - AdditiveMonoid_match - (vardecl - CConsAdditiveMonoid - (fun - [ (lam a (type) (fun a (fun a a))) a ] (fun a [ AdditiveMonoid a ]) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl `$fAdditiveMonoidInteger` [ AdditiveMonoid (con integer) ]) - [ - [ { CConsAdditiveMonoid (con integer) } addInteger ] - `$fAdditiveMonoidInteger_$czero` - ] - ) - (let - (rec) - (datatypebind - (datatype - (tyvardecl List (fun (type) (type))) - (tyvardecl a (type)) - List_match - (vardecl Nil [ List a ]) - (vardecl Cons (fun a (fun [ List a ] [ List a ]))) - ) - ) - (let - (nonrec) - (termbind - (nonstrict) - (vardecl - `$fFoldableList_$cfoldr` - (all - a - (type) - (all b (type) (fun (fun a (fun b b)) (fun b (fun [ List a ] b)))) - ) - ) - (abs - a - (type) - (abs - b - (type) - (lam - f - (fun a (fun b b)) - (let - (nonrec) - (termbind (strict) (vardecl f (fun a (fun b b))) f) - (lam - z - b - (let - (nonrec) - (termbind (strict) (vardecl z b) z) - (let - (rec) - (termbind - (nonstrict) - (vardecl go (fun [ List a ] b)) - (lam - ds - [ List a ] - { - [ - [ - { - [ { List_match a } ds ] (all dead (type) b) - } - (abs dead (type) z) - ] - (lam - x - a - (lam - xs - [ List a ] - (abs dead (type) [ [ f x ] [ go xs ] ]) - ) - ) - ] - (all dead (type) dead) - } - ) - ) - (lam eta [ List a ] [ go eta ]) - ) - ) - ) - ) - ) - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$fFoldableList` - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all b (type) (fun (fun a (fun b b)) (fun b (fun [ t a ] b)))) - ) - ) - List - ] - ) - `$fFoldableList_$cfoldr` - ) - (termbind - (nonstrict) - (vardecl - build - (all - a - (type) - (fun (all b (type) (fun (fun a (fun b b)) (fun b b))) [ List a ]) - ) - ) - (abs - a - (type) - (lam - g - (all b (type) (fun (fun a (fun b b)) (fun b b))) - [ - [ - { g [ List a ] } - (lam ds a (lam ds [ List a ] [ [ { Cons a } ds ] ds ])) - ] - { Nil a } - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - `$p1AdditiveMonoid` - (all - a - (type) - (fun [ AdditiveMonoid a ] [ (lam a (type) (fun a (fun a a))) a ]) - ) - ) - (abs - a - (type) - (lam + ~`$fAdditiveMonoidInteger_$czero` : integer = 0 + !addInteger : integer -> integer -> integer = addInteger + ~addInteger : integer -> integer -> integer + = \(x : integer) -> + let + !x : integer = x + in + \(y : integer) -> let !y : integer = y in addInteger x y + data (AdditiveMonoid :: * -> *) a | AdditiveMonoid_match where + CConsAdditiveMonoid : (\a -> a -> a -> a) a -> a -> AdditiveMonoid a + ~`$fAdditiveMonoidInteger` : AdditiveMonoid integer + = CConsAdditiveMonoid + {integer} + addInteger + `$fAdditiveMonoidInteger_$czero` + in + letrec + data (List :: * -> *) a | List_match where + Nil : List a + Cons : a -> List a -> List a + in + let + ~`$fFoldableList_$cfoldr` : all a b. (a -> b -> b) -> b -> List a -> b + = /\a b -> + \(f : a -> b -> b) -> + let + !f : a -> b -> b = f + in + \(z : b) -> + let + !z : b = z + in + letrec + ~go : List a -> b + = \(ds : List a) -> + List_match + {a} + ds + {all dead. b} + (/\dead -> z) + (\(x : a) (xs : List a) -> /\dead -> f x (go xs)) + {all dead. dead} + in + \(eta : List a) -> go eta + ~`$fFoldableList` : + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) List + = `$fFoldableList_$cfoldr` + ~build : all a. (all b. (a -> b -> b) -> b -> b) -> List a + = /\a -> + \(g : all b. (a -> b -> b) -> b -> b) -> + g {List a} (\(ds : a) (ds : List a) -> Cons {a} ds ds) (Nil {a}) + ~`$p1AdditiveMonoid` : all a. AdditiveMonoid a -> (\a -> a -> a -> a) a + = /\a -> + \(v : AdditiveMonoid a) -> + AdditiveMonoid_match + {a} v - [ AdditiveMonoid a ] - [ - { - [ { AdditiveMonoid_match a } v ] - [ (lam a (type) (fun a (fun a a))) a ] - } - (lam v [ (lam a (type) (fun a (fun a a))) a ] (lam v a v)) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl zero (all a (type) (fun [ AdditiveMonoid a ] a))) - (abs - a - (type) - (lam + {(\a -> a -> a -> a) a} + (\(v : (\a -> a -> a -> a) a) (v : a) -> v) + ~zero : all a. AdditiveMonoid a -> a + = /\a -> + \(v : AdditiveMonoid a) -> + AdditiveMonoid_match + {a} v - [ AdditiveMonoid a ] - [ - { [ { AdditiveMonoid_match a } v ] a } - (lam v [ (lam a (type) (fun a (fun a a))) a ] (lam v a v)) - ] - ) - ) - ) - (termbind - (nonstrict) - (vardecl - sum - (all - t - (fun (type) (type)) - (all - a - (type) - (fun - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all - b - (type) - (fun (fun a (fun b b)) (fun b (fun [ t a ] b))) - ) - ) - ) - t - ] - (fun [ AdditiveMonoid a ] (fun [ t a ] a)) - ) - ) - ) - ) - (abs - t - (fun (type) (type)) - (abs - a - (type) - (lam - `$dFoldable` - [ - (lam - t - (fun (type) (type)) - (all - a - (type) - (all - b (type) (fun (fun a (fun b b)) (fun b (fun [ t a ] b))) - ) - ) - ) - t - ] - (lam - `$dAdditiveMonoid` - [ AdditiveMonoid a ] - [ - [ - { { `$dFoldable` a } a } - [ { `$p1AdditiveMonoid` a } `$dAdditiveMonoid` ] - ] - [ { zero a } `$dAdditiveMonoid` ] - ] - ) - ) - ) - ) - ) - [ - [ - [ { { sum List } (con integer) } `$fFoldableList` ] - `$fAdditiveMonoidInteger` - ] - [ - { build (con integer) } - (abs - a - (type) - (lam - c - (fun (con integer) (fun a a)) - (lam - n - a - [ - [ c (con integer 1) ] - [ - [ c (con integer 2) ] - [ [ c (con integer 3) ] [ [ c (con integer 4) ] n ] ] - ] - ] - ) - ) - ) - ] - ] - ) - ) - ) -) \ No newline at end of file + {a} + (\(v : (\a -> a -> a -> a) a) (v : a) -> v) + ~sum : + all (t :: * -> *) a. + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) t -> + AdditiveMonoid a -> + t a -> + a + = /\(t :: * -> *) a -> + \(`$dFoldable` : + (\(t :: * -> *) -> all a b. (a -> b -> b) -> b -> t a -> b) t) + (`$dAdditiveMonoid` : AdditiveMonoid a) -> + `$dFoldable` + {a} + {a} + (`$p1AdditiveMonoid` {a} `$dAdditiveMonoid`) + (zero {a} `$dAdditiveMonoid`) + in + sum + {List} + {integer} + `$fFoldableList` + `$fAdditiveMonoidInteger` + (build + {integer} + (/\a -> \(c : integer -> a -> a) (n : a) -> c 1 (c 2 (c 3 (c 4 n)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/StdLib/9.6/errorTrace.pir.golden b/plutus-tx-plugin/test/StdLib/9.6/errorTrace.pir.golden index ebd70eca028..b0adcc556ce 100644 --- a/plutus-tx-plugin/test/StdLib/9.6/errorTrace.pir.golden +++ b/plutus-tx-plugin/test/StdLib/9.6/errorTrace.pir.golden @@ -1,39 +1,18 @@ -(program +program 1.1.0 (let - (nonrec) - (datatypebind - (datatype (tyvardecl Unit (type)) Unit_match (vardecl Unit Unit)) - ) - (termbind - (strict) - (vardecl error (all a (type) (fun (con unit) a))) - (abs a (type) (lam thunk (con unit) (error a))) - ) - (termbind - (strict) - (vardecl trace (all a (type) (fun (con string) (fun a a)))) - (builtin trace) - ) - (termbind (strict) (vardecl unitval (con unit)) (con unit ())) - (termbind - (nonstrict) - (vardecl traceError (all a (type) (fun (con string) a))) - (abs - a - (type) - (lam - str - (con string) - (let - (nonrec) - (termbind (strict) (vardecl str (con string)) str) - (termbind (strict) (vardecl x Unit) [ [ { trace Unit } str ] Unit ]) - [ { error a } unitval ] - ) - ) - ) - ) - [ { traceError (con integer) } (con string "") ] - ) -) \ No newline at end of file + data Unit | Unit_match where + Unit : Unit + !error : all a. unit -> a = /\a -> \(thunk : unit) -> error {a} + !trace : all a. string -> a -> a = trace + !unitval : unit = () + ~traceError : all a. string -> a + = /\a -> + \(str : string) -> + let + !str : string = str + !x : Unit = trace {Unit} str Unit + in + error {a} unitval + in + traceError {integer} "") \ No newline at end of file diff --git a/plutus-tx-plugin/test/StdLib/9.6/ratioInterop.eval.golden b/plutus-tx-plugin/test/StdLib/9.6/ratioInterop.eval.golden deleted file mode 100644 index 7418ebb255e..00000000000 --- a/plutus-tx-plugin/test/StdLib/9.6/ratioInterop.eval.golden +++ /dev/null @@ -1 +0,0 @@ -(con integer 4) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/lambda-default.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/lambda-default.uplc.golden index 24c6b451d7e..5ce90e153ef 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/lambda-default.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/lambda-default.uplc.golden @@ -1 +1 @@ -program 1.1.0 (\n m -> addInteger n m) \ No newline at end of file +(program 1.1.0 (\n m -> addInteger n m)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/lambda-nonstrict.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/lambda-nonstrict.uplc.golden index 24c6b451d7e..5ce90e153ef 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/lambda-nonstrict.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/lambda-nonstrict.uplc.golden @@ -1 +1 @@ -program 1.1.0 (\n m -> addInteger n m) \ No newline at end of file +(program 1.1.0 (\n m -> addInteger n m)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/lambda-strict.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/lambda-strict.uplc.golden index 24c6b451d7e..5ce90e153ef 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/lambda-strict.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/lambda-strict.uplc.golden @@ -1 +1 @@ -program 1.1.0 (\n m -> addInteger n m) \ No newline at end of file +(program 1.1.0 (\n m -> addInteger n m)) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden index fd1cb2d7d58..f0cea811d66 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-default.uplc.golden @@ -1,9 +1,9 @@ -program - 1.1.0 - (\m -> - force - (force - (force ifThenElse - (lessThanInteger m 0) - (delay (delay ((\cse -> addInteger cse cse) (error m)))) - (delay (delay m))))) \ No newline at end of file +(program + 1.1.0 + (\m -> + force + (force + (force ifThenElse + (lessThanInteger m 0) + (delay (delay ((\cse -> addInteger cse cse) (error m)))) + (delay (delay m)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden index fd1cb2d7d58..f0cea811d66 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-nonstrict.uplc.golden @@ -1,9 +1,9 @@ -program - 1.1.0 - (\m -> - force - (force - (force ifThenElse - (lessThanInteger m 0) - (delay (delay ((\cse -> addInteger cse cse) (error m)))) - (delay (delay m))))) \ No newline at end of file +(program + 1.1.0 + (\m -> + force + (force + (force ifThenElse + (lessThanInteger m 0) + (delay (delay ((\cse -> addInteger cse cse) (error m)))) + (delay (delay m)))))) \ No newline at end of file diff --git a/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden b/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden index fd1cb2d7d58..f0cea811d66 100644 --- a/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden +++ b/plutus-tx-plugin/test/Strictness/9.6/let-strict.uplc.golden @@ -1,9 +1,9 @@ -program - 1.1.0 - (\m -> - force - (force - (force ifThenElse - (lessThanInteger m 0) - (delay (delay ((\cse -> addInteger cse cse) (error m)))) - (delay (delay m))))) \ No newline at end of file +(program + 1.1.0 + (\m -> + force + (force + (force ifThenElse + (lessThanInteger m 0) + (delay (delay ((\cse -> addInteger cse cse) (error m)))) + (delay (delay m)))))) \ No newline at end of file